'TRADEPRC - prints out priced list of Trade orders before entry as Warehouse order external messbox() fentrybox() dpath vloadif() sch scw cpath shopmask nr5 external fgp userid scr dsa remove() vkeybox() $enternow ipath bgp invpath external lpath bge popuplist() city wraptext() #maxleft #minleft messboxwait() external entryline() messline() strcount() posnpopup() jobs[6] shopname bgi external bpopdb() increment() Background() progress() vunloadif() addidxrec() external makeidx() bbd fdp PrintReport() nr6 navrecs() delidxrec() vatrate external delstr() colpopup() findcolpop() strtoary() chkstr() chkdate() bgs external Exception() fgi fgs cr_warn nr8 $menu public ptstr ptval custcode prodcode $dayftr C_mask #due #gross #sumgross public ftrname custname deladdr1 deladdr2 deladdr3 deladdr4 #net #vat public offtel hometel mobile ftginstr ftgcomm cr_status balancedue faxnr public ptary[1] codes[1] #ordwidth desMRC $ccw refcode #receipts jobnr public plist[1,1] #refnr $screen psa custref #varngross docref global ver count $showdel Title_C() r1 r2 c1 c2 #recnr #cost_os #cost_diff global x y1 y2 ReturnToMenu() y deladdr custaddr custpost Authorise() c r t global custpostcode custaddr1 custaddr2 custcity custcontact varnr #precnr global j bline $update #bal_os #origlength #origcost #area #ordlength #addn global S_details #quant_diff WriteDetails() cust_title $uos $inv_now $msg global $itemtype $rollnr prodMRC #prodrec #currliststck $inv_prc $nextinvnr global #prevliststck #prec #newliststck WriteDelete() EnterCustName() l k global AddReqn() y3 s_shwreq #record $Emess AddVarnTrade() $retailcode sym global $backing $mess1 $smlc $smlr $prev_C ConfirmUpdate_yn() $altref $cuts global $prev_R $effecdate $disc prodSUPP suppcode $newcolor a1 #old_bar #int_bar #new_bar global #deflen $resvn maxwidth a2 a3 a4 a5 #mu_B #mu_A #mu_C #mu_T #nrrequsns global custorderdate #unitcost #reqncost $auth ChooseSupplier() $prevscn global priceauthority $color i $colorstr $altlen PreparePrice() mu_profile global currentorder ordref specterm purchorderdate $price_R $price_C delquot global $unsort $newsort n $prodend #var ChooseColour() ChooseWidth() $suffix global mess suppname $comment orderby consecnr UpdateEntries() AddVarn() global strtcol recs $popstr #nritems strtrow keyf keyb EnterVarnOrder() global Title_A() ChooseLength() Confirm_yn() Title_B() upd_new CheckUsed() global AmendReqns() UpdateReqn() jobidx #reqnrec $unit $delterms $priceterms global endcol Warning() EnterColour() ShowBox() SortColour() #nextrefnr addr1 global DeleteReqn() #old_bal #new_bal $deladdr $del ProcessTrade() #price global #jobrec #reqnrecs S_save $instruct z f1 f2 f3 f4 #int_bal $oldnr global clearvar() x1 x2 CreateReqn() CheckBalance() l1 l2 c3 Entries() global #reqnlen $stock $ccwcode WriteRecord() AlterBalance() #balrem global $stat p1 p2 p3 p4 p5 p6 #length #totreqn #stk_BAR #stk_Bal $mess2 global b1 b2 pl lc sc #reslen $rescust StockStatus() $index $file $length global addn_lab $mess3 $text1 $text2 $text3 #deld $increqn whseman global $test EnterCustomer() #bline #tline ftgdate cr_limit EnterDiscount() global $popcol CheckDupe() EnterNewOrder() EnterOverride() EnterPurchord() global OrderedBy() EnterNewOverride() PopLengths() $shopuse #addnVAT global Check_CCW() $tradecode $stkcarp PrintConfirmation() RollorCut() global uistrcnt() mr blen rec drows pg tr #unused CheckDelivered() global CheckPrice() Title_A1() MAIN local uc ar1 ar2 single-step off Background() file unload all keyf = 7 keyb = 0 $retailcode = "T00000" $tradecode = "T00000" $shopuse = "T02221 T11071 T02762 T11068" #gross = 0 #varngross = 0 $stkcarp = 0 p3 = 1 ' p3 = printer to be used (1=HPIII_QC; 2=GEN_EPSN etc) p4 = 2 ' p4 = printer port to use (1,2 etc - network set to use 2=LASER; 3=LABEL) p5 = 1 ' p5 = choose VIEW/PRINT 1=PRINT; 2=VIEW; 3=CHOOSE p6 = 1 ' p6 = nr of copies $delterms = "2/3’days 7’days 7-10’days’ 14’days Other" $priceterms = "Cut’Price Roll’Price Other" prodcode = "" refcode = "" remove("thisordr.idx") makeidx("tradeprc","thisordr.idx","0",1) while true $inv_now = EnterCustomer() if $inv_now = -1 'delete order nr/mark as cancelled exit while elseif $inv_now = 1 ReturnToMenu() end if while true ar1 = AddReqn() ' 2=no reqns if ar1 = 2 if cr_status = "C" or cr_status = "T" messbox(" Abandon this order? (y/n) ",1,0,1) if ptstr == "y" 'YES - mark order as deleted & increment OrdNr ' vloadif(dpath|"trd_ent4.vw") vloadif(dpath|"cus_ent4.vw") for i = 1 to records lock-record [Retail]=0 [Length_Quantity]=0 [Cost]=0 [Cost_OS]=0 [Quant_OS]=0 [Comment]="Abandoned order" write-record data delete record data goto record next end for end if vloadif(dpath|"cust_ord.vws") lock-record ' [Job_Nr]=blank [Completed]="N" [Description]="Abandoned order" write-record data delete record increment(dpath|"tradenrs.dat",1) ReturnToMenu() else continue while end if elseif ar1 = 1 continue while end if if cr_status = "N" ' use custcode as jobnr ' jobnr = custcode else increment(dpath|"tradenrs.dat",1) end if ar2 = AmendReqns() if ar2 = 0 exit while elseif ar2 = -1 'delete order nr or mark as cancelled ReturnToMenu() else continue while end if end while if cr_status = "C" or cr_status = "T" EnterVarnOrder() PrintConfirmation("ordrcnf1.dfr") exit while elseif cr_status = "A" or cr_status = "D" EnterVarnOrder() ' print Confirmation Sheet?? - done by pricing/estimating system ' enter items to GOODSOUT, print Collection Note and mark as Completed=Y PrintConfirmation("ordrcnf1.dfr") exit while elseif cr_status = "N" PrintConfirmation("trd_cnf2.dfr") exit while elseif cr_status = "F" messbox(" Franchise customers not dealt with by this system yet ",0,0,1) end if end while if $stkcarp = 1 messbox(" Allocate now? (y/n) ",1,1,1) if ptstr == "y" execute "reqall_J.rf3" in-memory end if end if ReturnToMenu() END MAIN FUNCTION PrintConfirmation(fn) deladdr1 = "Collection" if cr_status = "N" vloadif(dpath|"trd_conf.vw") else vloadif(dpath|"requsn.vws") end if order change index "thisordr.idx" if records = 0 messbox(" No new records to process ",0,0,1) return (1) end if order sort execute dictionary "lst_stck" index "lst_stck" PrintReport(fn,"Confirmation",p3,p4,p5,p6) return (0) END FUNCTION 'PrintConfirmation() FUNCTION WriteDetails() ' write customer & job details to CUSENT3B vloadif(dpath|"cust_ord.vws") data enter lock [Customer_Code] = custcode [Job_Nr] = jobnr [Type_Branch] = "H" [Branch] = left(jobnr,1) [SalesAnalysis] = "T" [Order_Status] = "U" [Date_Of_Order] = today [Last_Update] = today [Updated_By] = userid [Description] = "Trade order" [Delivery_Address_1] = "Collected" [CustOrd_Name] = custname [Abbrv_Name] = left(custname,7) [Invoice_Total] = 0 [Net_Invoice] = 0 [Balance_Due] = 0 [PDA] = "N" [Origin] = "C" [Completed] = "N" [Customer_Ref] = custref write-record END FUNCTION ' WriteDetails() FUNCTION ReturnToMenu() lock module jobnr screen clear box 1 1 sch scw 0 0 no-border repaint off error off while true window close if cerror exit while end if end while file unload all transfer cpath|"pm_menu.psl" in-memory END FUNCTION FUNCTION WriteRecord() '######################## - REQUSN.DB ' message "#newliststck) is:"&str(#newliststck) ' message "refcode is:"&str(refcode) ' message "prodcode) is:"&str(prodcode) ' message "prodMRC) is:"&str(prodMRC) ' message "desMRC) is:"&str(desMRC) ' message "$itemtype) is:"&str($itemtype) ' message "$stat) is:"&str($stat) ' message "#ordlength) is:"&str(#ordlength) ' message "#reqncost is:"&str(#reqncost) ' message "round(#reqncost,2)) is:"&str(round(#reqncost,2)) ' message "$auth) is:"&str($auth) ' message "#ordwidth) is:"&str(#ordwidth) ' message "$ccwcode) is:"&str($ccwcode) ' message "$rollnr) is:"&str($rollnr) ' message "$backing) is:"&str($backing) ' message "#prodrec) is:"&str(#prodrec) ' message "custref is:"&str(custref) ' message "custcode is:"&str(custcode) ' message "#addn is:"&str(#addn) refcode = jobnr|"-"|str(right("00"|str(#nextrefnr),2)) 'message "refcode is:"&str(refcode) data enter lock [Lst_Stck] = #newliststck [Reference_Nr] = refcode ' assign [Reference_Nr] to record [Job_Nr] = left(refcode,6) [Branch] = left(refcode,1) [Product_Code] = prodcode [Product_MRC] = prodMRC [Description_MRC] = desMRC [Item_Type] = $itemtype [Status] = $stat [Length_Quantity] = #ordlength [Quant_OS] = #ordlength [Date_Requisitioned] = today [Cost] = round(#reqncost,2) [Cost_OS] = round(#reqncost,2) [CustCode] = custcode [Comment] = custref [Width] = #ordwidth [Created/Changed_By] = userid [CCW_Code] = $ccwcode [RollNr] = $rollnr [R_Backing] = $backing [Retail] = #addn [prodrec] = #prodrec write-record $increqn = "Y" #precnr = precord vloadif(dpath|"cus_ent4.vw") order change physical x = addidxrec("current.idx",#precnr,7) 'message "addidxrec @ L779 is:"&str(x) x = addidxrec("thisordr.idx",#precnr,7) 'message "addidxrec @ L779 is:"&str(x) order change index "current.idx" 'message "records is:"&str(records) #gross = #gross + #addn 'message "#gross is:"&str(#gross) return (0) END FUNCTION 'WriteRecord() FUNCTION StockStatus() '#################### vloadif(dpath|"chk_stat.vw") order change key "[Job_Nr]" data find "[Job_Nr]" equal jobnr options "" lock-record [Stock_Status]="P" write-record END FUNCTION ' StockStatus() FUNCTION CreateReqn() #newliststck = case $itemtype ("A","4")("B","2")("C","1")("J","3")("F","5")\ ("S","1")("T","2")("V","1")("W","2")("O","6") if $itemtype = "C" Check_CCW() $rollnr = "00000/00" $stat = "I" elseif $itemtype = "S" Check_CCW() $rollnr = "00000/00" $stat = "I" elseif $itemtype = "V" Check_CCW() $rollnr = "00000/00" $stat = "I" elseif $itemtype = "O" $rollnr = "BESPOK" $stat = "A" elseif $itemtype = "B" $stat = "I" $rollnr = "BESPOK" elseif $itemtype = "J" $stat = "I" $rollnr = "BESPOK" elseif $itemtype = "T" $stat = "I" $rollnr = "BESPOK" elseif $itemtype = "W" $stat = "I" $rollnr = "BESPOK" else $stat = "A" $rollnr = "NA" end if while true vloadif(dpath|"cus_ent4.vw") order change physical if file("current.idx") = 0 ' message "Making new index" makeidx("requsn","current.idx","0",1) end if if file("thisordr.idx") = 0 ' message "Making new index" makeidx("requsn","thisordr.idx","0",1) end if WriteRecord() ' entry order #nextrefnr = #nextrefnr + 1 'message "#nextrefnr is:"&str(#nextrefnr) if #nextrefnr = 100 #nextrefnr = 1 end if ' message "#nextrefnr is:"&str(#nextrefnr) #ordlength = 0 exit while end while END FUNCTION ' CreateReqn() FUNCTION AddReqn() '###################### local z #deflen $wrongprod f1 f2 f3 nr_reqns nr_index ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Show current requsn's ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ upd_new = "NEW" vloadif(dpath|"cus_ent4.vw") order change key "[CustCode]" data query execute "cust_ref.dfq" index "c0.idx" ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' [CustCode] = jobnr ' and ' not(deleted) ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if cerror #nextrefnr = 1 'message "382/ cerror - #nextrefnr is:"&str(#nextrefnr) else #nextrefnr = filemax([#refnr])+1 'message "385/ #nextrefnr is:"&str(#nextrefnr) if #nextrefnr = 100 #nextrefnr = 1 end if end if order change key "[Job_Nr]" data query execute "job_reqn.dfq" index "c1.idx" ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' [Job_Nr] = jobnr ' and ' not(deleted) ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if cerror remove("current.idx") makeidx("requsn","current.idx","0",1) order change index "current.idx" else data query execute "tradeord.dfq" index "current.idx" ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' [Job_Nr] = jobnr ' and ' [Quant_OS]>0 ' and ' not(deleted) ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if cerror remove("current.idx") makeidx("requsn","current.idx","0",1) order change index "current.idx" end if end if error off data goto record last Title_A() repaint off ptval=0 while true prodcode = "" x = inchar 'message "x is:"&str(x) '######################################## if x = 315 ' F1 clearvar() continue while elseif x = 316 ' F2 - Stock Carpet - IT = "A" $stkcarp = 1 $prodend ="A" while true vloadif(dpath|"cus_ent4.vw") error off clearvar() ' message "prodsel|$prodend is:"&str("prodsel"|$prodend) vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"stckcarp.idx" if prodcode = "" y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0) else data goto record record-number #prodrec y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0) end if if x = -1 repaint off vloadif(dpath|"cus_ent4.vw") order change index "current.idx" y2 = format("Select requisition type or {F10} to exit","M72") screen print 21 5 fgp bbd y2 vloadif(dpath|"prodsel"|$prodend|".vw") exit while end if #prodrec = record prodcode = ptstr ' message "prodcode -L1430- is:"&str(prodcode) $backing = [Backing] $uos = [Unit_Of_Sale] ' message "$uos is:"&str($uos) screen shortrestore dsa x = Entries(0) if x = -1 screen clear box 5 5 22 77 0 0 no-border screen shortrestore s_shwreq repaint off continue while elseif x = 0 ' new entry made vloadif(dpath|"cus_ent4.vw") order change index "current.idx" data goto record last Title_A() ' message "prodsel|$prodend is:"&str("prodsel"|$prodend) vloadif(dpath|"prodsel"|$prodend|".vw") continue while end if end while elseif x = 317 ' F3 - Bespoke Carpet - IT = "B" if cr_status = "C" or cr_status = "T" messboxwait(" Cash sale - cannot order Bespoke items ",0,0,1) continue while end if $prodend = "B" while true ' bpop must show Supplier name, Suppcode & Backing vloadif(dpath|"cus_ent4.vw") error off clearvar() vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"bespcarp.idx" if prodcode = "" y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) else data goto record record-number #prodrec y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) end if if x = -1 repaint off vloadif(dpath|"cus_ent4.vw") order change index "current.idx" y2 = format("Select requisition type or {F10} to exit","M72") screen print 21 5 fgp bbd y2 vloadif(dpath|"prodsel"|$prodend|".vw") exit while end if #prodrec = record prodcode = ptstr ' message "prodcode -L1489- is:"&str(prodcode) $backing = [Backing] $uos = [Unit_Of_Sale] ' message "$uos is:"&str($uos) screen shortrestore dsa x = Entries(0) if x = -1 screen clear box 5 5 22 77 0 0 no-border screen shortrestore s_shwreq repaint off continue while elseif x = 0 vloadif(dpath|"cus_ent4.vw") order change index "current.idx" data goto record last Title_A() vloadif(dpath|"prodsel"|$prodend|".vw") continue while end if end while elseif x = 318 ' F4 - Stock Ancl - IT = "A" if cr_status = "N" messboxwait(" Trade Account - use separate routine for Ancillaries ",0,0,1) continue while end if $prodend = "A" while true ' bpop must show MRC name (& Backing) vloadif(dpath|"cus_ent4.vw") error off clearvar() vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"stckancl.idx" if prodcode = "" y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0) else data goto record record-number #prodrec y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0) end if if x = -1 repaint off vloadif(dpath|"cus_ent4.vw") order change index "current.idx" y2 = format("Select requisition type or {F10} to exit","M72") screen print 21 5 fgp bbd y2 vloadif(dpath|"prodsel"|$prodend|".vw") exit while end if #prodrec = record prodcode = ptstr $uos = [Unit_Of_Sale] $backing = [Backing] screen shortrestore dsa x = Entries(0) if x = -1 screen clear box 5 5 22 77 0 0 no-border screen shortrestore s_shwreq repaint off continue while elseif x = 0 screen clear box 1 1 sch scw 0 0 no-border vloadif(dpath|"cus_ent4.vw") order change index "current.idx" data goto record last Title_A() vloadif(dpath|"prodsel"|$prodend|".vw") continue while end if end while elseif x = 319 ' F5 - Bespoke Ancl - IT = "J" if cr_status = "C" or cr_status = "T" messboxwait(" Cash sale - cannot order Bespoke items ",0,0,1) continue while end if $prodend = "B" while true ' bpop must show MRC name (& Backing?) & Suppcode vloadif(dpath|"cus_ent4.vw") error off #refnr = filemax([#refnr]) 'message "#refnr) is:"&str(#refnr) if cerror #refnr = 0 end if refcode = jobnr|"-"|str(right("00"|str(#refnr+1),2))' clearvar() vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"bespancl.idx" ' message "F5 - prodcode is:"&str(prodcode) if prodcode = "" y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) else data goto record record-number #prodrec y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) end if if x = -1 repaint off vloadif(dpath|"cus_ent4.vw") order change index "current.idx" y2 = format("Select requisition type or {F10} to exit","M72") screen print 21 5 fgp bbd y2 vloadif(dpath|"prodsel"|$prodend|".vw") exit while end if #prodrec = record prodcode = ptstr $uos = [Unit_Of_Sale] $backing = [Backing] screen shortrestore dsa x = Entries(0) if x = -1 screen clear box 5 5 22 77 0 0 no-border screen shortrestore s_shwreq repaint off continue while elseif x = 0 vloadif(dpath|"cus_ent4.vw") order change index "current.idx" data goto record last Title_A() vloadif(dpath|"prodsel"|$prodend|".vw") continue while end if end while elseif x = 320 ' F6 - Vinyl - IT = "V or W" if cr_status = "C" or cr_status = "T" messboxwait(" Cash sale - cannot order Bespoke items ",0,0,1) continue while end if $prodend = "B" while true vloadif(dpath|"cus_ent4.vw") error off clearvar() vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"vinyl.idx" ' bpop must show MRC ?????????????? if prodcode = "" y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) else data goto record record-number #prodrec y2 = format(" Scroll or press {F3} to search - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"i","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) end if if x = -1 repaint off vloadif(dpath|"cus_ent4.vw") order change index "current.idx" y2 = format("Select requisition type or {F10} to exit","M72") screen print 21 5 fgp bbd y2 vloadif(dpath|"prodsel"|$prodend|".vw") exit while end if #prodrec = record prodcode = ptstr $uos = [Unit_Of_Sale] $backing = [Backing] $itemtype= [Item_Type] if $itemtype = "V" $stkcarp = 1 end if screen shortrestore dsa x = Entries(0) if x = -1 screen clear box 5 5 22 77 0 0 no-border screen shortrestore s_shwreq repaint off continue while elseif x = 0 vloadif(dpath|"cus_ent4.vw") order change index "current.idx" data goto record last Title_A() vloadif(dpath|"prodsel"|$prodend|".vw") continue while end if end while elseif x = 321 ' F7 - Tiles - IT = "S or T" $prodend = "B" while true vloadif(dpath|"cus_ent4.vw") error off clearvar() vloadif(dpath|"prodsel"|$prodend|".vw") x = popuplist(20,59,25,"Stock Bespoke","",1,0) if x = -1 exit while end if if ptstr = "Stock" order change index ipath|"stk_tile.idx" ' bpop must show MRC ?????????????? else if cr_status = "C" or cr_status = "T" messboxwait(" Cash sale - cannot order Bespoke items ",0,0,1) exit while end if order change index ipath|"bsp_tile.idx" ' bpop must show MRC ?????????????? end if if prodcode = "" y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) else data goto record record-number #prodrec y2 = format(" Scroll or press {F3} to search - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"i","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) end if if x = -1 repaint off vloadif(dpath|"cus_ent4.vw") order change index "current.idx" y2 = format("Select requisition type or {F10} to exit","M72") screen print 21 5 fgp bbd y2 vloadif(dpath|"prodsel"|$prodend|".vw") exit while end if #prodrec = record prodcode = ptstr $uos = [Unit_Of_Sale] $backing = [Backing] $itemtype= [Item_Type] if $itemtype = "S" $stkcarp = 1 end if screen shortrestore dsa x = Entries(0) if x = -1 screen clear box 5 5 22 77 0 0 no-border screen shortrestore s_shwreq repaint off Title_C() continue while elseif x = 0 vloadif(dpath|"cus_ent4.vw") order change index "current.idx" data goto record last Title_A() vloadif(dpath|"prodsel"|$prodend|".vw") continue while end if end while elseif x = 322 ' F8 - Fitting - IT = "F" clearvar() continue while elseif x = 323 ' F9 - reservations clearvar() continue while elseif x = 324 ' F10 - order change physical vloadif(dpath|"cus_ent4.vw") if records > 0 if $menu<>"boss" if #gross < 20 if cr_status = "T" messbox(" Current order is below œ20. Abandon? (y/n) ",1,0,1) if ptstr == "n" order change index "current.idx" continue while else order change index "current.idx" data query execute "delete.dfq" ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ not(deleted) replace delete ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ return (1) end if end if end if end if screen clear box 22 1 sch scw 0 0 no-border return (0) else ' no reqns entered OR active return (2) end if screen clear box 22 1 sch scw 0 0 no-border return (0) elseif x = 763 ' {Esc} - if no records then abandon return (2) end if end while data goto record last return (0) END FUNCTION ' AddReqn() FUNCTION Title_A() '################## local y0 #left y1 = format(left(jobnr&"-"&custname&"(Order value"¤cy(#gross*(100+vatrate)/100)|")",72),"M72") y3 = format(" Description Colour Length Width Bckg","L72") repaint on repaint if cr_status = "N" or cr_status = "A" or cr_status = "D" #left = #unused-#gross if #left < cr_warn and #left >= 0 y0 = format("Credit Available"¤cy(#unused-#gross),"R80") screen print 1 1 14 0 y0 elseif #left < 0 y0 = format("Exceeding Credit Limit by"¤cy(-#unused+#gross),"R80") screen print 1 1 12 0 y0 elseif #left > cr_warn y0 = format("Credit Available"¤cy(#unused-#gross),"R80") screen print 1 1 10 0 y0 else end if end if screen print 5 5 15 12 y1 screen print 6 5 fdp bbd y3 y2 = format("Select requisition type or {F10} to exit","M72") screen print 21 5 fgp bbd y2 screen save 5 5 21 77 s_shwreq repaint off Title_C() END FUNCTION 'Title_A() FUNCTION Title_C() f1 = format(" F2 ³ F3 ³ F4 ³ F5 ³ F6 ³ F7 ³ ","L80") f2 = format(" Stock ³ Bespoke ³ Stock ³ Bespoke ³ Vinyls ³ Tiles ³ ","L80") f3 = format(" Carpet ³ Carpet ³ Ancll'y ³ Ancll'y ³ ³ ³ ","L80") screen print 22 1 keyf keyb f1 screen print 23 1 keyf keyb f2 screen print 24 1 keyf keyb f3 END FUNCTION 'Title_C() FUNCTION UpdateEntries() '########################## ' get variables from PRODSELA.VW $itemtype = [Item_Type] 'message "$itemtype) is:"&str($itemtype) prodMRC = [Product_MRC] $backing = "N/A" $mess1 = "" $smlc = [SM_List_Cuts] $smlr = [SM_List_Rolls] $effecdate = [Effect_Date] $disc = [Discount_%] prodSUPP = [Product_Supplier] suppcode = [Supplier_Code] while true ' start selection of widths colours etc if $altlen = "Y" x = ChooseLength() if x = -1 return (-1) end if end if x = ConfirmUpdate_yn() if x = -1 ' {Esc} pressed return (-1) elseif x = 1 ' not accepted continue while else return (0) end if end while END FUNCTION ' UpdateEntries() FUNCTION Confirm_yn(c) 'c=0 is genuine entry; c=1 is price enquiry if upd_new = "NEW" #reqnrec = 0 end if if $itemtype = "B" or $itemtype = "J" or $itemtype = "T" or $itemtype = "W" if upd_new = "NEW" purchorderdate = today else purchorderdate = date2([Date_Ordered]) orderby = [Ordered_By] delquot = [Delivery_Quoted] $comment = [Comments] specterm = [Special_Terms] ordref = [Order_Reference] end if if c = 0 ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Enter Effective Date for pricing ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ while true x = entryline(" Date Goods ordered from Supplier ",10,"##\/##\/####",purchorderdate,21,5,72) if x = 0 purchorderdate = ptstr if chkdate(purchorderdate,1) = -1 messbox(" Incorrect date - re-enter ",0,0,1) continue while end if screen clear box 22 5 22 77 0 0 no-border exit while end if end while elseif c = 1 purchorderdate = today end if ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Calculate which Price to use ³ ' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if days(purchorderdate) < days($effecdate) $price_R = $prev_R*(1-($disc/100)) $price_C = $prev_C*(1-($disc/100)) else $price_R = $smlr*(1-($disc/100)) $price_C = $smlc*(1-($disc/100)) end if RollorCut() elseif $itemtype = "A" or $itemtype = "C" or $itemtype = "S" or $itemtype = "V" elseif $itemtype = "O" $length = "O" #unitcost = 1 end if if cr_status = "T" 'TRADE - use CutLengthCost x MU PreparePrice("T",#ordlength,#ordwidth) elseif cr_status = "N" 'TRADE - use CutLengthCost x MU PreparePrice("T",#ordlength,#ordwidth) elseif cr_status = "A" or cr_status = "C" or cr_status = "D" 'RETAIL - use Retail price PreparePrice("R",#ordlength,#ordwidth) end if if c = 0 while true $unit = [Unit_Desc] $uos = [Unit_Of_Sale] #area = #ordlength*#ordwidth if $uos = "U3" if $backing = "COMM" $mess3 = " Commission of œ"|fixed(#ordlength,2)|"? (y/n/Esc) " else if $itemtype = "F" $mess3 = prodMRC&"for œ"|fixed(#ordlength,2)|"? (y/n/Esc) " else $mess3 = prodMRC&"of œ"|fixed(#ordlength,2)|" from"&suppname|"? (y/n/Esc) " end if end if else $text1 = fixed(#ordlength,2)&$unit&"(Area "|fixed(#area,2)|"sm / Sale price "|currency(#addnVAT)|" inc VAT)? (y/n/Esc) " $text2 = fixed(#ordlength,2)&"(Sale price "|currency(#addnVAT)|" inc VAT)? (y/n/Esc) " $text3 = fixed(#ordlength,2)&"(Sale price "|currency(#addnVAT)|" inc VAT)? (y/n/Esc) " $mess3 = case $itemtype ("B",$text1)("C",$text1)("V",$text1)("W",$text1)\ ("A",$text2)("F",$text3)("J",$text2)("S",$text2)("T",$text2)("O",$text3) else $text1 end if f1 = format("Select `No' to enter Discount","M72") screen print 22 5 15 1 f1 x = messline($mess3,1,1,0,21,5,72) if x = 0 if ptstr == "n" f1 = format(" ","M72") screen print 22 5 15 1 f1 x = messline(" Do you want to give a discount? (y/n) ",1,1,0,21,5,72) if ptstr == "n" screen clear box 22 5 22 77 0 0 no-border return (-1) elseif ptstr == "y" EnterDiscount() $text1 = fixed(#ordlength,2)&$unit&"(Area "|fixed(#area,2)|"sm / Sale price "|currency(#addnVAT)|" inc VAT)? (y/n/Esc) " $text2 = fixed(#ordlength,2)&"(Sale price "|currency(#addnVAT)|" inc VAT)? (y/n/Esc) " $text3 = fixed(#ordlength,2)&"(Sale price "|currency(#addnVAT)|" inc VAT)? (y/n/Esc) " $mess3 = case $itemtype ("B",$text1)("C",$text1)("V",$text1)("W",$text1)\ ("A",$text2)("F",$text3)("J",$text2)("S",$text2)("T",$text2)("O",$text3) else $text1 x = messline($mess3,1,1,0,21,5,72) if x = 0 if ptstr == "y" screen clear box 22 5 22 77 0 0 no-border repaint off exit while elseif ptstr == "n" screen clear box 22 5 22 77 0 0 no-border return (-1) end if elseif x = -1 screen clear box 22 5 22 77 0 0 no-border return (-1) end if end if elseif ptstr == "y" screen clear box 22 5 22 77 0 0 no-border repaint off exit while end if elseif x = -1 screen clear box 22 5 22 77 0 0 no-border return (-1) end if end while repaint off ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Create Purchase order for bespoke & check prices ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if $itemtype = "B" x = EnterPurchord() if x = -1 return (-1) end if elseif $itemtype = "J" x = EnterPurchord() ' returns #unitcost if x = -1 return (-1) end if elseif $itemtype = "T" x = EnterPurchord() ' returns #unitcost if x = -1 return (-1) end if elseif $itemtype = "W" x = EnterPurchord() ' returns #unitcost if x = -1 return (-1) end if elseif $itemtype = "O" #unitcost = 1 if $backing = "OVER" x = EnterOverride() ' if x = -1 return (-1) end if end if else end if #unitcost = #price 'message "#unitcost is:"&str(#unitcost) ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Calculate req'n cost ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if $uos = "U3" #reqncost = value(#ordlength) elseif $uos = "U1" #reqncost = value(#ordlength)*value(#unitcost) elseif $uos = "U2" #reqncost = value(#ordlength)*value(#ordwidth)*value(#unitcost) end if end if if c = 0 if #reqnrec = 0 CreateReqn() else vloadif(dpath|"cus_ent7.vw") ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Assign revised figures to REQUSN & PURCHORD ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if $itemtype = "C" $rollnr = "00000/00" elseif $itemtype = "B" $rollnr = "BESPOK" else $rollnr = "NA" end if while true lock-record [Product_Code] = prodcode [Product_MRC] = prodMRC [Description_MRC] = desMRC [Item_Type] = $itemtype [Status] = "I" [Length_Quantity] = #ordlength [Date_Requisitioned] = today [Cost] = round(#reqncost,2) [Comment] = custref [Width] = #ordwidth [Created/Changed_By] = userid [CCW_Code] = $ccwcode [RollNr] = $rollnr [R_Backing] = $backing [prodrec] = #prodrec write-record #prec = str(precord) vloadif(dpath|"requsn.vws") order change physical vloadif(dpath|"cus_ent4.vw") exit while end while end if elseif c = 1 $text3 = " Selling price "|currency(#addn)|" ("|currency(#addnVAT)|" inc VAT) " x = messboxwait($text3,0,1,1) end if END FUNCTION ' Confirm_yn() FUNCTION Title_B() '########################## local f1 f2 f3 y2 y3 y1 = format(" R E V I E W S C R E E N ","M72") y2 = format(left(jobnr&"-"&custname,72),"M72") y3 = format(" Description Colour Length Width Bckg","L72") repaint on repaint screen print 4 5 15 12 y1 screen print 5 5 15 12 y2 screen print 6 5 fdp bbd y3 y2 = format("{U}pdate reqn - {D}elete reqn - {F10} finishes","M72") screen print 21 5 fgp bbd y2 END FUNCTION 'Title_B() FUNCTION Warning() '######################### local cl1 cl2 r1 = 8 r2 = r1+8 c1 = 7 c2 = c1+66 cl1 = 15 cl2 = 12 screen clear box 18 7 18 73 15 12 no-border screen save r1 c1 r2 c2 S_save screen clear box r1 c1 r2 c2 cl1 cl2 y1 = format("This order will be passed to Head Office for authorization","M65") y2 = format("and you CANNOT add or re-allocate requisitions after that.","M65") y3 = format(" Without authorization, it cannot be prepared for fitting.","M65") screen print r1+2 c1+1 cl1 cl2 y1 screen print r1+4 c1+1 cl1 cl2 y2 screen print r1+6 c1+1 cl1 cl2 y3 END FUNCTION 'Warning() FUNCTION Warning_C() '########################## local cl1 cl2 r1 = 8 r2 = r1+8 c1 = 7 c2 = c1+66 cl1 = 15 cl2 = 12 screen clear box 18 7 18 73 15 12 no-border screen save r1 c1 r2 c2 S_save screen clear box r1 c1 r2 c2 cl1 cl2 y1 = format("This order will be APPROVED for the goods to be despatched","M65") y2 = format("and you CANNOT add or re-allocate requisitions after that.","M65") y3 = format(" Without this approval, the goods cannot be released.","M65") screen print r1+2 c1+1 cl1 cl2 y1 screen print r1+4 c1+1 cl1 cl2 y2 screen print r1+6 c1+1 cl1 cl2 y3 END FUNCTION 'Warning_C() FUNCTION CheckBalance() '################## vloadif(dpath|"stk_carp.vws") order change key "[RollNr]" data find "[RollNr]" equal $rollnr options "" if cerror messline(" Stock roll not found ",0,1,1,21,5,72) screen clear box 22 1 22 scw 0 0 no-border vloadif(dpath|"cus_ent7.vw") return (1) end if #record = precord #old_bal = [Balance] #old_bar = [BAR] vloadif(dpath|"cus_ent7.vw") #int_bal = #old_bal + #ordlength #int_bar = #old_bar + #ordlength while true 'message "#ordlength is:"&str(#ordlength) messline(" Are you re-allocating from the same roll? (y/n) ",1,1,1,21,5,72) if ptstr == "y" while true $mess2 = " Enter Length required (5cm steps) " x = entryline(prodcode&"-"&mid($mess2,3,33),6,nr6,#ordlength,21,5,72) if x = 0 if value(ptstr) = 0 continue while elseif $itemtype = "S" #ordlength = value(ptstr) exit while elseif round(mod(value(ptstr)*100,5),0)=0 or round(mod(value(ptstr)*100,5),0)=5 #ordlength = value(ptstr) screen clear box 22 1 22 scw 0 0 no-border exit while else ptstr = value(ptstr) x = round(ptstr*20,0)/20 #ordlength = round(@if(x #minleft messline(" Cannot leave balance between 0.6m and 5.0m on roll - re-enter? (y/n) ",1,0,1,21,5,72) if ptstr == "y" screen clear box 22 1 22 scw 0 0 no-border continue while else screen clear box 22 1 22 scw 0 0 no-border vunloadif("stk_carp.vws") return (1) end if else vloadif(dpath|"stk_carp.vws") data goto record record-number #record lock-record [Balance] = #new_bal [BAR] = #new_bar write-record vunloadif("stk_carp.vws") vloadif(dpath|"cus_ent7.vw") lock-record [Length_Quantity] = #ordlength write-record return (1) end if elseif ptstr == "n" ' NOT re-allocating from same roll #new_bal = #old_bal + #ordlength 'message "#old_bal is:"&str(#old_bal) #new_bar = #old_bar + #ordlength 'message "#old_bal is:"&str(#old_bal) if #new_bal < #maxleft and #new_bal > #minleft messline(" Cannot update (balance on roll between 0.6m and 5.0m) ",0,0,1,21,5,72) screen clear box 22 1 22 scw 0 0 no-border vunloadif("stk_carp.vws") return (1) else vloadif(dpath|"stk_carp.vws") data goto record record-number #record lock-record [Balance] = #new_bal [BAR] = #new_bar write-record vunloadif("stk_carp.vws") vloadif(dpath|"cus_ent7.vw") $rollnr = "00000/00" exit while end if end if end while END FUNCTION 'CheckBalance() FUNCTION AlterBalance() '####################### repaint off vloadif(dpath|"stk_carp.vws") order change key "[RollNr]" data find "[RollNr]" equal $rollnr options "" if cerror messline(" Stock roll not found ",0,1,1,21,5,72) screen clear box 22 1 22 scw 0 0 no-border vunloadif("stk_carp.vws") vloadif(dpath|"cus_ent7.vw") return (1) end if #record = precord #old_bal = [Balance] #old_bar = [BAR] vloadif(dpath|"cus_ent7.vw") #int_bal = #old_bal + #ordlength #int_bar = #old_bar + #ordlength while true 'message "#ordlength is:"&str(#ordlength) #new_bal = #old_bal + #ordlength 'message "#old_bal is:"&str(#old_bal) #new_bar = #old_bar + #ordlength 'message "#old_bal is:"&str(#old_bal) if #new_bal < #maxleft and #new_bal > #minleft messline(" Cannot delete - will leave a balance of"&fixed(#new_bal,2)|"m ",0,0,1,21,5,72) return (1) end if vloadif(dpath|"stk_carp.vws") data goto record record-number #record lock-record [Balance] = #new_bal [BAR] = #new_bar write-record vunloadif("stk_carp.vws") vloadif(dpath|"cus_ent7.vw") $rollnr = "00000/00" return (0) end while END FUNCTION 'AlterBalance() FUNCTION ChooseLength() '###################### while true $uos = [Unit_Of_Sale] $mess2 = " Enter Quantity required " x = entryline($mess2,6,nr6,#ordlength,21,5,72) if x = -1 return (-1) end if if x = 0 if value(ptstr) = 0 continue while elseif $itemtype = "S" #ordlength = value(ptstr) exit while elseif round(mod(value(ptstr)*100,5),0)=0 or round(mod(value(ptstr)*100,5),0)=5 #ordlength = value(ptstr) exit while else ptstr = value(ptstr) x = round(ptstr*20,0)/20 #ordlength = round(@if(x #ordlength $resvn = 0 end if exit while end if end while repaint off END FUNCTION 'ChooseLength() FUNCTION Authorise() '######################## vloadif(dpath|"cus_ent7.vw") order change physical vloadif(dpath|"cus_ent8.vw") order change index "current.idx" repaint on repaint Title_B() repaint off ' $fail = "" $update = "N" r1 = 7 while true if x = -1 messbox(" Abandon Authorisation process? (y/n) ",1,0,1) if ptstr == "y" exit while else continue while end if end if exit while end while END FUNCTION ' Authorise() FUNCTION WriteDelete() '################# lock-record [Reference_Nr] = left(refcode,7)|"00" [Job_Nr] = "" [Status] = "D" [Date_Status_Changed] = today [Created/Changed_By] = userid [RollNr] = "" data delete record write-record #recnr = record vloadif(dpath|"cus_ent7.vw") END FUNCTION 'WriteDelete() FUNCTION AmendReqns() '####################### vloadif(dpath|"cus_ent7.vw") order change index "current.idx" ' order change index ipath|jobidx Title_B() ptval=0 while true ptval = navrecs() if ptval = {U} or ptval = {u} messboxwait(" Not yet in use - delete & re-enter ",0,0,1) Title_B() elseif ptval = {D} or ptval = {d} x = DeleteReqn() Title_B() elseif ptval = {F10} messline(" Finished with all Requisitions for"&jobnr|"? (y/n)",1,1,1,21,5,72) Background() if ptstr == "y" 'message "records) is:"&str(records) if records > 0 if filemin([Cost]) = 0 ' check for Zero costs messbox(" One or more items not costed ",0,0,1) y2 = format("{U}pdate reqn - {D}elete reqn - {F10} finishes","M72") screen print 21 5 fgp bbd y2 continue while else return (0) end if else return (-1) end if else repaint off vunloadif("cus_ent7.vw") y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72") return (1) end if end if end while END FUNCTION ' AmendReqns() FUNCTION UpdateReqn() ' in vloadif(dpath|"cus_ent7.vw") '############## local s_prodsel1 s_prodsel2 s_prodsel3 s_prodshw $rollnr = [RollNr] refcode = [Reference_Nr] prodcode = [Product_Code] ' message "prodcode - L821 - is:"&str(prodcode) prodMRC = [Product_MRC] desMRC = [Description_MRC] $itemtype = [Item_Type] #ordlength = [Length_Quantity] #origlength = [Length_Quantity] #bal_os = [Quant_OS] custref = [Comment] #ordwidth = [Width] $backing = [R_Backing] #prodrec = [prodrec] $ccwcode = [CCW_Code] #reqnrec = record #reqncost = [Cost] #origcost = [Cost_OS] #addn = [Retail] repaint off upd_new = "UPD" case $itemtype when "A" $prodend = "A" while true screen save 1 1 6 scw s_prodsel1 screen save 7 1 20 42 s_prodsel2 screen save 21 1 sch scw s_prodsel3 vloadif(dpath|"prodshw"|$prodend|".vw") order change index ipath|"stckancl.idx" data goto record record-number #prodrec repaint on repaint screen shortrestore s_prodsel1 screen shortrestore s_prodsel2 screen shortrestore s_prodsel3 y2 = format("","M72") screen print 21 5 fgp bbd y2 #prodrec = record prodcode = [Product_Code] ' message "prodcode -L917- is:"&str(prodcode) $backing = [Backing] repaint off vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"stckancl.idx" data goto record record-number #prodrec x = UpdateEntries() repaint off vloadif(dpath|"cus_ent7.vw") order change index "current.idx" Title_B() repaint on exit while end while end case END FUNCTION ' UpdateReqn() FUNCTION DeleteReqn()'################# local #cd repaint off $rollnr = [RollNr] refcode = [Reference_Nr] prodcode = [Product_Code] 'message "prodcode -L456- is:"&str(prodcode) prodMRC = [Product_MRC] desMRC = [Description_MRC] $itemtype = [Item_Type] #ordlength = [Length_Quantity] custref = [Comment] #ordwidth = [Width] $backing = [R_Backing] #prodrec = [prodrec] #reqnrec = record #bal_os = [Quant_OS] ' message "Check whether any has been delivered ie. has a DOCREF" #cd = CheckDelivered(refcode) ' if #cd > 0 messboxwait(" Cannot delete -"&str(x)&"already delivered ",0,0,1) return (1) end if x = WriteDelete() order change physical x = delidxrec("current.idx",#recnr,1) if records = 0 messbox(" No more to delete ",0,1,1) return (1) end if order change index "current.idx" Title_B() END FUNCTION 'DeleteReqn() FUNCTION ProcessTrade() '######################### local vardesc notif repaint off vloadif(dpath|"trade_1.vw") order change key "[Job_Nr]" data find "[Job_Nr]" equal jobnr options "gw" if cerror ' if none - then return messbox(" Job not found - no worksheet printed ",0,0,1) return (-1) else custname = [Customer_Name] deladdr1 = [Address_1] deladdr2 = [Address_2] deladdr3 = [City/Town] deladdr4 = [Postcode] faxnr = [Office_Fax] vloadif(dpath|"tradecnf.vw") order change key "[Job_Nr]" data query execute "job_reqn.dfq" index "trade_1.idx" ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' [Job_Nr] = jobnr ' and ' not(deleted) ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if cerror return (-1) end if #var = filesum([InvValue]) varnr = jobnr|"-00" vardesc = "Items as per Confirmation Sheet" custref = "" notif = "Tradecnf" x = AddVarnTrade(varnr,#var,vardesc,custref,notif,today) ' sort by LstOrder vloadif(dpath|"tradecnf.vw") order sort execute dictionary "lst_stck" index "lst_stck" PrintReport("tradecnf.dfr","",p3,p4,p5,p6) return (0) end if END FUNCTION 'ProcessTrade() FUNCTION AddVarnTrade(varnr,#varngross,$reas,$ref,$notif,$varndate) '######## local balancedue lastbal newtotal oldtotal newnet oldnet #prec x #as #sr vloadif(dpath|"addvarn3.vw") data enter lock [Var_Nr] = varnr [VarnJobNr] = left(varnr,6) [Amount_Gross] = #varngross [Reason] = $reas [Customers_Ref] = $ref [Notif_Method] = $notif [Date] = $varndate [Entered_By] = userid write-record lastbal = round([Balance_Due],2) balancedue = lastbal + #gross oldtotal = round([Invoice_Total],2) newtotal = oldtotal + #gross oldnet = round([Net_Invoice],2) newnet = oldnet + round(#gross*100/(100+vatrate),2) lock-record [Balance_Due] = balancedue [Invoice_Total] = newtotal [Net_Invoice] = newnet [Order_Status] = "P" write-record END FUNCTION ' AddVarnTrade() FUNCTION EnterCustName() local fentline abbrv_name fentline = " Enter Customer's Name (or 1st SEVEN letters if existing customer)" while true while true x = fentrybox(fentline,35,"","") if x = 0 if ptstr = "" continue while end if exit while elseif x = -1 return (-1) end if end while custname = ptstr vloadif(dpath|"custsel4.vw") order change key [Abbrv_Name] abbrv_name = proper(left(custname,7)) data find "[Abbrv_Name]" equal abbrv_name options "" if cerror messbox(" Name not held on file - enter as Cash Sale? (y/n)",1,0,1) if ptstr == "y" return (1) else continue while end if end if vloadif(dpath|"custsel4.vw") repaint on repaint ptval=0 y1 = format(" CUSTOMERS ON FILE ","M71") y2 = format(" {S}elect highlighted - {Esc} exits ","M71") screen print 4 6 fgp bgp y1 screen print 20 6 fgp bgp y2 while true ptval = navrecs() if ptval = {S} or ptval = {s} if (deleted) messboxwait(" Deleted record - choose another ",0,0,1) continue while end if $msg = [Customer_Name]&"of"&[Address_1]|"?" 'message "len($msg)) is:"&str(len($msg)) messbox($msg,1,1,1) if ptstr == "y" custcode = [Customer_Code] custname = [Customer_Name] cr_limit = [Credit_Limit] cr_status = [Credit_Status] mu_profile= [Profile] return (0) else y2 = format(" {S}elect highlighted - {Esc} exits ","M71") screen print 20 6 fgp bgp y2 continue while end if repaint off elseif ptval = {Esc} Background() return (-1) end if end while end while END FUNCTION 'EnterCustName() FUNCTION EnterCustomer() ' finds Job & updates Cust_Ord local ct messbox(" œ20 minimum order for Trade customers. Continue? (y/n) ",1,1,1) if ptstr == "n" return (1) end if while true Background() x = popuplist(8,31,13,"Trade’Account Retail’Cash Trade’Cash","",1,0) ct = ptstr if x = -1 return (-1) end if messbox(" Do you want to check prices first? (y/n) ",1,1,1) if ptstr == "y" if ct = "Retail’Cash" cr_status = "C" mu_profile= "R" elseif ct = "Trade’Cash" cr_status = "T" mu_profile= "T" elseif ct = "Trade’Account" vloadif(dpath|"customer.vws") order change index ipath|"collectn.idx" repaint off x = bpopdb("customer",6,"","[Customer_Name]","l35","[Customer_Code]","L6","[Customer_Code]",6,21,19,58,"",0) if x = 0 custcode = ptstr custname = [Customer_Name] cr_limit = [Credit_Limit] cr_status = [Credit_Status] mu_profile= [Profile] addr1 = [Address_1] end if end if CheckPrice() continue while end if if ct = "Retail’Cash" while true x = fentrybox("Enter customer's name",35,"","") if x = 0 if ptstr = "" continue while end if custname = ptstr messbox(" Confirm name as"&custname|"? (y/n) ",1,1,1) if ptstr == "y" exit while end if elseif x = -1 continue while end if end while custcode = $retailcode cr_limit = 0 cr_status = "C" mu_profile= "R" exit while elseif ct = "Trade’Cash" while true x = fentrybox("Enter customer's name",35,"","") if x = 0 if ptstr = "" continue while end if exit while elseif x = -1 continue while end if end while custname = ptstr custcode = $tradecode cr_limit = 0 cr_status = "T" mu_profile= "T" exit while elseif ct = "Trade’Account" vloadif(dpath|"customer.vws") order change index ipath|"collectn.idx" repaint off x = bpopdb("customer",6,"","[Customer_Name]","l35","[Customer_Code]","L6","[Customer_Code]",6,21,19,58,"",0) if x = 0 custcode = ptstr custname = [Customer_Name] cr_limit = [Credit_Limit] cr_status = [Credit_Status] mu_profile= [Profile] addr1 = [Address_1] messbox(custname&"of"&addr1|"? (y/n) ",1,1,1) if ptstr == "y" exit while else Background() continue while end if elseif x = -1 Background() continue while end if end if end while Background() if cr_status = "N" ' use custcode as jobnr jobnr = custcode else fopen dpath|"tradenrs.dat" as 1 fread 1 into $oldnr 'message "Last Trade nr was:"&str($oldnr) fclose 1 $oldnr = value($oldnr)+1 jobnr = "T"|right("00000"|str($oldnr),5) 'message "jobnr is:"&str(jobnr) end if clear ptval ' while true while true x = fentrybox(" Enter"&custname|"'s reference ",20,"","") if x = -1 return (1) end if custref = ptstr if len(ptstr)=0 continue while else exit while end if end while if cr_status = "N" return (0) end if x = messbox(" "|custname&"- Job Nr:"&jobnr&"- correct? (y/n) ",1,1,1) if x = 0 if ptstr == "n" continue while end if end if repaint off WriteDetails() return (0) end while END FUNCTION ' EnterCustomer() FUNCTION EnterVarnOrder() vloadif(dpath|"cus_ent7.vw") order change index "current.idx" for i = 1 to records #addn = [Retail] #varngross = #varngross + #addn data goto record next end for #varngross = round(#varngross*((100+vatrate)/100),2) varnr = jobnr|"-00" AddVarn(varnr,#varngross,"Goods supplied as per attached sheet ref:"|docref,"Collection","COLLECTN",today) if cr_status = "C" or cr_status = "T" ' message "show Order as completed" end if END FUNCTION ' EnterVarnOrder() FUNCTION AddVarn(varnr,#varngross,$reas,$ref,$notif,$varndate) local balancedue lastbal newtotal oldtotal newnet oldnet #prec x #as #sr vloadif(dpath|"addvarn3.vw") data enter lock [Var_Nr] = varnr [VarnJobNr] = left(varnr,6) [Amount_Gross] = #varngross [Reason] = $reas [Customers_Ref] = $ref [Notif_Method] = $notif [Date] = $varndate [Entered_By] = userid write-record lastbal = round([Balance_Due],2) balancedue = lastbal + #varngross oldtotal = round([Invoice_Total],2) newtotal = oldtotal + #varngross oldnet = round([Net_Invoice],2) newnet = oldnet + round(#varngross*100/(100+vatrate),2) lock-record [Balance_Due] = balancedue [Invoice_Total] = newtotal [Net_Invoice] = newnet [Order_Status] = "U" [Completed] = "Y" write-record END FUNCTION 'AddVarn() FUNCTION Entries(c) 'c=0 is genuine entry; c=1 is price enquiry ' get variables from PRODSELA.VW $itemtype = [Item_Type] prodMRC = [Product_MRC] $backing = [Backing] if $itemtype = "B" or $itemtype = "C" $mess1 = "("|$backing|")" elseif $itemtype = "O" if $backing = "OVER" repaint off if len(suppname)>0 messbox(prodMRC&"from"&suppname|"?",1,0,1) if ptstr == "n" ChooseSupplier() end if else ChooseSupplier() end if repaint off vloadif(dpath|"prodselb.vw") order change index ipath|"bespancl.idx" elseif $backing = "COMM" repaint off vloadif(dpath|"prodselb.vw") order change index ipath|"bespancl.idx" end if else $backing = "N/A" $mess1 = "" end if if $itemtype <> "O" $smlc = [SM_List_Cuts] $smlr = [SM_List_Rolls] $prev_C = [Prev_SMLC] $prev_R = [Prev_SMLR] $effecdate = [Effect_Date] $disc = [Discount_%] prodSUPP = [Product_Supplier] suppcode = [Supplier_Code] $prev_C = @if($prev_C="",$smlc,$prev_C) $prev_R = @if($prev_R="",$smlr,$prev_R) end if while true ' start selection of widths colours etc if c = 0 x = ChooseColour() if x = -1 return (-1) elseif x = 2 ' new colour continue while end if end if x = ChooseWidth() if x = -1 return (-1) end if if $itemtype = "B" or $itemtype = "C" x = ChooseLength() if x = -1 return (-1) end if x = Confirm_yn(c) if c = 0 if x = -1 ' {Esc} pressed return (-1) elseif x = 1 ' not accepted continue while else return (0) end if elseif c = 1 return (-1) end if else x = ChooseLength() if x = -1 return (-1) end if x = Confirm_yn(c) if c = 0 if x = -1 ' {Esc} pressed return (-1) elseif x = 1 ' not accepted continue while else return (0) end if elseif c = 1 return (-1) end if end if end while END FUNCTION ' Entries() FUNCTION ChooseWidth() while true ' start WIDTH section if $itemtype = "A" #ordwidth = value([Widths_Available]) exit while elseif $itemtype = "O" #ordwidth = value([Widths_Available]) exit while elseif $itemtype = "F" #ordwidth = value([Widths_Available]) exit while elseif $itemtype = "S" #ordwidth = value([Widths_Available]) exit while elseif $itemtype = "T" #ordwidth = value([Widths_Available]) exit while else ' ÉĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶ» ' ŗ Enter & check width ŗ ' ČĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶ¼ while true if [Widths_Available] ! "V" maxwidth = right([Widths_Available],5) x = entryline(" This carpet is available in any width upto"&maxwidth|"m",5,"","",21,5,72) if x = 0 #ordwidth = value(ptstr) if #ordwidth > value(maxwidth) messline(" Width cannot be greater than"&maxwidth|"m",0,0,1,21,5,72) continue while elseif #ordwidth = "" continue while end if exit while end if end if screen print 21 5 fgp bgp y2 screen shortrestore dsa strcount([Widths_Available]) #nritems = ptval strtrow = 17 - #nritems screen clear box 21 5 22 77 0 0 no-border y2 = format(" Select Width and press {Enter} - {Esc} to enter new colour","M72") screen print 21 5 fgp bbd y2 while true if upd_new = "NEW" $popstr = [Widths_Available] exit while else $popstr = [Widths_Available] x = delstr(str(#ordwidth),$popstr) if x = -1 exit while end if $popstr = str(#ordwidth)&ptstr exit while end if end while x = colpopup(strtrow,68,19,$popstr,"",1,0,4,0,0,7) if x = 0 #ordwidth = value(ptstr) screen shortrestore dsa exit while end if end while exit while end if end while ' end of WIDTH section END FUNCTION ' ChooseWidth() FUNCTION ChooseColour() while true ' start COLOURS section case $itemtype when "A" desMRC = "N/A" exit while when "O" desMRC = left(suppname,20) exit while when "F" if prodcode == addn_lab x = entryline(" Additional description ",20,"","",21,5,72) desMRC = ptstr else desMRC = "N/A" end if exit while otherwise ' Check colours & add if necessary while true $popstr = [Colours] if upper($popstr) ! "N/A" desMRC = $popstr exit while else x = strcount($popstr) if x = -1 x = EnterColour() ' returns - (0) Success; (1) Unable to add if x = 1 ShowBox() return (-1) elseif x = -1 return (-1) elseif x = 0 desMRC = $newcolor return (2) ' new colour end if desMRC = $newcolor continue while else #nritems = ptval end if strtcol = 0 for i = 1 to #nritems y = GROUP($popstr,i) x = len(GROUP($popstr,i)) if x > strtcol strtcol = x end if end for strtcol = 72 - strtcol screen clear box 21 5 22 77 0 0 no-border y2 = format(" Select colour and press {Enter} - {Esc} to enter new colour ","M72") screen print 21 5 fgp bbd y2 if ASC(desMRC) = 0 $popcol = colpopup(7,strtcol,18,[Colours],"",1,0,14,11,0,7) else $popcol = findcolpop(7,strtcol,18,[Colours],"",desMRC,1,0,14,11,0,7) if $popcol = -5 $popcol = colpopup(7,strtcol,18,[Colours],"",1,0,14,11,0,7) end if end if if $popcol = 0 desMRC = ptstr exit while elseif $popcol = -1 screen shortrestore dsa $popcol = EnterColour() ' returns - (0) Success; (1) Unable to add if $popcol = 1 ShowBox() return (-1) elseif $popcol = -1 return (-1) elseif $popcol = 0 desMRC = $newcolor return (2) end if desMRC = $newcolor exit while elseif $popcol = -2 $popcol = EnterColour() ' returns - (0) Success; (1) Unable to add if $popcol = 1 ShowBox() return (-1) elseif $popcol = -1 exit while elseif $popcol = 0 exit while end if desMRC = $newcolor exit while end if end if end while end case exit while end while ' end of Colour check END FUNCTION ' ChooseColour() FUNCTION EnterColour() local $fldlen $usedlen $fldlen = dbfldinfo("[Colours]",2) $usedlen = str(len([Colours])) while true x = entryline(" Enter Colour Description or {Esc} to abandon ",20,"","",21,5,72) if x = 0 if ptstr = "" continue while end if $color = proper(ptstr) if len(ptstr) > (value($fldlen) - value($usedlen)) return (1) ' !!!!!!!!!!!!!!!! TEST ONLY end if x = messline(" Confirm new Colour -"&$color|"? (y/n)",1,1,1,21,5,72) if x = 0 if ptstr == "n" continue while else x = CheckDupe($color) ' 0 OK if x = 0 ' -1 maybe - show popup exit while ' -2 DUPLICATE elseif x = -1 scr = scr - 2 messline($color&"- duplicated?",0,0,1,21,5,72) y2 = format(" "|chr(24)&chr(25)&"to find - {Enter} to select colour - {Esc} if not listed ","M72") screen print 21 5 fgp bgp y2 screen shortrestore dsa x = popuplist(8,57,18,[Colours],"",1,0) if x = -1 ' {Esc} pressed x = messline(" Confirm "|$color&"(y/n)",1,1,1,21,5,72) if ptstr == "y" scr = scr + 2 exit while else continue while end if else ' Alternative selected $newcolor = ptstr scr = scr + 2 exit while end if elseif x = -2 continue while end if end if end if elseif x = -1 return (-1) end if end while y = strtoary($color) $newcolor = "" for i = 1 to ptval if i = 1 $newcolor = ptary[i] ' NB - space is Alt-255 else $newcolor = $newcolor|"’"|ptary[i] ' NB - space is Alt-255 end if end for $unsort = [Colours]&trim($newcolor) repaint off SortColour() vloadif(dpath|"prodsel"|$prodend|".vw") lock-record [Colours] = $newsort write-record return (0) END FUNCTION ' EnterColour() FUNCTION SortColour() vloadif("temp_skl.vws") if precords <> 0 data query execute "delete" vunloadif("temp_skl.vws") data utilities purge "temp_skl" end if vloadif(dpath|"prodsel"|$prodend|".vw") x = strcount($unsort) ' message "x is:"&str(x) n = value(ptval) repaint off if value(n) = 0 return ($unsort) end if x = strtoary($unsort) ' message "x is:"&str(x) vloadif("temp_SKL.vws") for x = 1 to n data enter lock [Colour] = ptary[x] write-record end for if n > 1 order sort now dictionary "new" fields "[Colour]" ascending data goto record first end if $newsort = "" for x = 1 to n $newsort = $newsort&[Colour] data goto record next end for ' if precords = 1 data delete record else data query execute "delete" end if vunloadif("temp_skl.vws") data utilities purge "temp_skl" return $newsort END FUNCTION ' SortColour() FUNCTION CheckDupe($color) $colorstr = [Colours] x = chkstr($color,$colorstr) 'message "x) is:"&str(x) if x = -1 ' $color NOT found in $colorstr strtoary($color) for i = 1 to ptval y = ptary[i] if match($colorstr,y) <> 0 ' one word exists in $colorstr return (-1) ' MAYBE ! else return (0) ' NOT a duplicate end if end for elseif x = 0 ' $color found in $colorstr screen shortrestore psa scr = scr - 2 messline($color&"is a duplicate!",0,0,1,21,5,72) scr = scr + 2 return (-2) end if END FUNCTION 'CheckDupe() FUNCTION ShowBox() local x x1 x2 x3 x4 x5 x6 load lpath|"wraptext.rf3" in-memory screen clear box 1 1 sch scw 0 0 no-border repaint off x1 = " Insufficient space in [Colours] field to add: " x2 = "’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’" x3 = $color x4 = "’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’" x5 = " Report Product Code"&prodcode&"to Supervisor press {Esc} to continue" x = x1&x2&x3&x4&x5 wraptext(8,15,15,65,fgp,bge,x,"M",1,0,1) unload "wraptext.rf3" END FUNCTION ' ShowBox() FUNCTION EnterPurchord() refcode = jobnr|"-"|str(right("00"|str(#nextrefnr),2)) 'message "refcode is:"&str(refcode) vloadif(dpath|"besp_chk.vw") order change key "[Order_Nr]" data find "[Order_Nr]" equal refcode options "" if cerror x = EnterNewOrder() if x = -1 return (-1) end if vunloadif("besp_chk.vw") exit function else currentorder = precord x = EnterNewOrder() if x = -1 return (-1) end if vunloadif("besp_chk.vw") exit function end if END FUNCTION ' EnterPurchord() FUNCTION UpdatePurchord() vloadif(dpath|"besp_chk.vw") order change key "[Order_Nr]" data find "[Order_Nr]" equal refcode options "" if cerror return (-1) else currentorder = precord orderby = [Ordered_By] purchorderdate = [Date_Ordered] delquot = [Delivery_Quoted] $comment = [Comments] specterm = [Special_Terms] upd_new = "UPD" x = EnterNewOrder() if x = -1 return (-1) end if vunloadif("besp_chk.vw") exit function end if END FUNCTION ' UpdatePurchord() FUNCTION ConfirmUpdate_yn() 'Obtain reference & show confirmation box while true ' ?? $unit = [Unit_Desc] #area = #ordlength*#ordwidth $uos = [Unit_Of_Sale] if $uos = "U3" if $backing = "COMM" $mess3 = " Commission of œ"|fixed(#ordlength,2)|"? (y/n/Esc) " else if $itemtype = "F" $mess3 = prodMRC&"for œ"|fixed(#ordlength,2)|"? (y/n/Esc) " else $mess3 = prodMRC&"of œ"|fixed(#ordlength,2)|" from"&suppname|"? (y/n/Esc) " end if end if else $text1 = " Confirm "|fixed(#ordlength,2)&$unit&"(total area "|fixed(#area,2)|"sq m)? (y/n/Esc) " $text2 = " Confirm quantity "|fixed(#ordlength,2)|"? (y/n/Esc) " $text3 = " Confirm "|fixed(#ordlength,2)|"? (y/n/Esc) " $mess3 = case $itemtype ("B",$text1)("C",$text1)("V",$text1)("W",$text1)\ ("A",$text2)("F",$text3)("J",$text2)("S",$text2)("T",$text2)("O",$text3) else $text1 end if x = messline($mess3,1,1,0,21,5,72) if x = 0 if ptstr == "n" screen clear box 22 5 22 77 0 0 no-border return (1) elseif ptstr == "y" screen clear box 22 5 22 77 0 0 no-border repaint off exit while end if elseif x = -1 screen clear box 22 5 22 77 0 0 no-border return (-1) end if end while repaint off ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Create Purchase order for bespoke & check prices ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if $itemtype = "B" x = UpdatePurchord() ' returns #unitcost if x = -1 return (-1) end if elseif $itemtype = "J" x = UpdatePurchord() ' returns #unitcost if x = -1 return (-1) end if elseif $itemtype = "T" x = UpdatePurchord() ' returns #unitcost if x = -1 return (-1) end if elseif $itemtype = "W" x = UpdatePurchord() ' returns #unitcost if x = -1 return (-1) end if elseif $itemtype = "O" #unitcost = 1 if $backing = "OVER" x = EnterOverride() ' if x = -1 return (-1) end if end if else ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Calculate which Price to use - (SMLR - disc) at date of order ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if days(custorderdate) < days($effecdate) #unitcost = round($prev_R*(1-($disc/100)),2) ' ROLL price used for all other prods else #unitcost = round($smlr*(1-($disc/100)),2) end if end if if $uos = "U3" #reqncost = value(#ordlength) elseif $uos = "U1" #reqncost = value(#ordlength)*value(#unitcost) elseif $uos = "U2" #reqncost = value(#ordlength)*value(#ordwidth)*value(#unitcost) end if vloadif(dpath|"cus_ent7.vw") ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Assign revised figures to REQUSN & PURCHORD ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ #quant_diff = #ordlength - #origlength #bal_os = #bal_os + #quant_diff #cost_os = #cost_os + #cost_diff while true lock-record ' refcode/itemtype/status - NOT changed [Product_Code] = prodcode [Product_MRC] = prodMRC [Description_MRC] = desMRC [Length_Quantity] = #ordlength [Quant_OS] = #bal_os [Cost] = round(#reqncost,2) [Cost_OS] = #cost_os [Comment] = custref [Width] = #ordwidth [Created/Changed_By] = userid [CCW_Code] = $ccwcode [RollNr] = $rollnr [R_Backing] = $backing [prodrec] = #prodrec write-record #prec = str(precord) vloadif(dpath|"requsn.vws") order change physical vloadif(dpath|"cus_ent4.vw") exit while end while END FUNCTION ' ConfirmUpdate_yn() FUNCTION EnterNewOrder() local mess oldstrt ordref = "" specterm = "" while true ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Enter quoted delivery ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ while true $popstr = $delterms x = strcount($popstr) if x = 0 #nritems = ptval else end if strtrow = 21 - 2 - #nritems endcol = 0 for i = 1 to #nritems y = GROUP($popstr,i) x = len(GROUP($popstr,i)) if x > endcol endcol = x end if end for strtcol = 2 while true if ASC(delquot) = 0 $popcol = colpopup(strtrow,strtcol,20,$popstr,"",1,0,11,13,0,7) else $popcol = findcolpop(strtrow,strtcol,20,$popstr,"",delquot,1,0,11,13,0,7) if $popcol = -5 $popcol = colpopup(strtrow,strtcol,20,$popstr,"",1,0,11,13,0,7) end if end if if $popcol = 0 exit while end if end while if ptstr = "Other" screen shortrestore dsa while true x = entryline(" Delivery quoted ",20,"","",21,5,72) if x = 0 delquot = ptstr exit while end if end while else delquot = ptstr end if screen shortrestore dsa exit while end while vloadif(dpath|"supplier.vws") suppname = filelookup([Supplier_Code],[Name],suppcode) vunloadif("supplier.vws") vloadif(dpath|"cus_ent4.vw") ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Enter comments & delivery address re Purchase ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if upd_new = "NEW" $comment = "None" end if x = colpopup(2,2,13,"Warehouse’ Branch To’Site Collect","Delivery",1,0,15,12,0,7) if ptstr = "Warehouse’" $del = "W" elseif ptstr = "Branch" screen shortrestore dsa x = colpopup(2,16,13,"Fulham Raynes Putney Sheen","Branch",1,0,10,13,0,7) $deladdr = ptstr $del = left(ptstr,1) elseif ptstr = "To’Site" $del = "S" while true screen shortrestore dsa x = entryline(" Site address/notes ",30,"","",21,5,72) if x = 0 if ptstr = "" continue while end if $deladdr = ptstr exit while end if end while elseif ptstr = "Collect" $del = "O" end if while true x = entryline(" Any comments on Purchase Order ",40,"",$comment,21,5,72) if x = 0 $comment = ptstr exit while end if end while screen clear box 22 5 22 77 0 0 no-border ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Supplier's reference ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if upd_new = "NEW" ordref = "" while true x = entryline(" "|suppname|"'s reference ",20,"*20{XU}",ordref,21,5,72) if x = 0 ordref = ptstr if ordref = "" messline(" Must enter Supplier's reference! ",0,0,1,21,5,72) continue while else exit while end if end if end while else ordref = $altref end if screen clear box 22 5 22 77 0 0 no-border ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Ordered by? ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ repaint off y2 = format(" Enter name of person ordering from Supplier ","M72") screen print 21 5 fgp bgp y2 OrderedBy() y2 = format(" ","M72") screen print 21 5 fgp bgp y2 x = messline("’"|fixed(#ordlength,2)&$unit&"ordered by"&orderby&"on"&purchorderdate&"? (y/n/Esc) ",1,0,0,21,5,72) if x = 0 if ptstr == "y" repaint off exit while end if elseif x = -1 screen clear box 22 5 22 77 0 0 no-border return (-1) end if end while vloadif(dpath|"ent_pord.vw") if $uos = "U3" #reqncost = value(#ordlength) elseif $uos = "U1" #reqncost = value(#ordlength)*value(#unitcost) elseif $uos = "U2" #reqncost = value(#ordlength)*value(#ordwidth)*value(#unitcost) end if ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ create/update PURCHORD record and make all assignments ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if upd_new = "NEW" data enter lock elseif upd_new = "UPD" order change key "[Order_Nr]" data find "[Order_Nr]" equal refcode options "" if cerror x = messbox(" Purchase Order not found - cannot update ",1,0,0) return (-1) end if lock-record end if [Supp_Code] = suppcode [Width] = #ordwidth [Length_Quantity] = #ordlength [Balance_OS] = #ordlength [Order_Reference] = ordref [Ordered_By] = orderby [Date_Ordered] = purchorderdate [Product_Code] = prodcode [Order_Nr] = refcode [Delivery_Quoted] = delquot [Comments] = $comment [Special_Terms] = specterm [Last_Update] = today [Updated_By] = userid [Carpet_Color] = desMRC [Order_Cost] = #reqncost [Unit_Cost] = #unitcost [Order_Status] = "P" [Del] = $del [DelNotes] = $deladdr write-record END FUNCTION ' EnterNewOrder() FUNCTION ChooseSupplier() vloadif(dpath|"supplier.vws") order change physical order sort now dictionary "suppname" fields "[Name]" ascending repaint off while true y1 = format(" Choose Supplier making Charge ","M72") screen print 21 5 15 1 y1 x = bpopdb("supplier",6,"","[Name]","L42","[Supplier_Code]","L6","[Supplier_Code]",7,36,20,80,"",0) if x = 0 exit while elseif x = -1 screen clear box 1 1 sch scw 0 0 no-border return (-1) end if end while suppcode = ptstr suppname = [Name] END FUNCTION ' ChooseSupplier() FUNCTION EnterOverride() ' If $itemtype = "B", check Purchase Order entered vloadif(dpath|"besp_chk.vw") order change key "[Order_Nr]" data find "[Order_Nr]" equal refcode options "" if cerror x = EnterNewOverride() if x = -1 return (-1) end if vunloadif("besp_chk.vw") exit function else currentorder = precord orderby = [Ordered_By] purchorderdate = [Date_Ordered] prodcode = [Product_Code] delquot = "N/A" $comment = "Override charge" x = EnterNewOverride() if x = -1 return (-1) end if vunloadif("besp_chk.vw") exit function end if END FUNCTION ' EnterOverride() FUNCTION EnterNewOverride() local mess oldstrt deldate ordref = "" specterm = "" if upd_new = "NEW" purchorderdate = today else purchorderdate = date2([Date_Ordered]) orderby = [Ordered_By] prodcode = [Product_Code] delquot = [Delivery_Quoted] $comment = [Comments] ordref = [Order_Reference] end if while true while true ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Enter comments re Purchase ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ while true deldate = date2(days(today)+2) x = entryline(" Enter agreed delivery date ",10,"##\/##\/####",deldate,21,5,72) if x = 0 $comment = "Agreed delivery date -"&ptstr delquot = ptstr exit while end if end while screen clear box 22 5 22 77 0 0 no-border vloadif(dpath|"cus_ent4.vw") ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Enter comments & delivery address re Purchase ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if upd_new = "NEW" $comment = "None" end if x = colpopup(2,2,13,"Warehouse’ Branch To’Site Collect","Delivery",1,0,15,12,0,7) if ptstr = "Warehouse’" $del = "W" elseif ptstr = "Branch" screen shortrestore dsa x = colpopup(2,16,13,"Fulham Raynes Putney Sheen","Branch",1,0,10,13,0,7) $deladdr = ptstr $del = left(ptstr,1) elseif ptstr = "To’Site" $del = "S" while true screen shortrestore dsa x = entryline(" Site address/notes ",30,"","",21,5,72) if x = 0 if ptstr = "" continue while end if $deladdr = ptstr exit while end if end while elseif ptstr = "Collect" $del = "O" end if while true x = entryline(" Any comments on Purchase Order ",40,"",$comment,21,5,72) if x = 0 $comment = ptstr exit while end if end while screen clear box 22 5 22 77 0 0 no-border ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Supplier's reference ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if upd_new = "NEW" ordref = "" while true x = entryline(" "|suppname|"'s reference ",20,"*20{XU}",ordref,21,5,72) if x = 0 ordref = ptstr if ordref = "" messline(" Must enter Supplier's reference! ",0,0,1,21,5,72) continue while else exit while end if end if end while else ordref = $altref end if screen clear box 22 5 22 77 0 0 no-border ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Ordered by? ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ repaint off y2 = format(" Enter name of person ordering from Supplier ","M72") screen print 21 5 fgp bgp y2 OrderedBy() y2 = format(" ","M72") screen print 21 5 fgp bgp y2 x = messline("’Charge of"¤cy(#ordlength)&"accepted by"&orderby&"on"&purchorderdate&"? (y/n/Esc) ",1,0,0,21,5,72) if x = 0 if ptstr == "y" repaint off exit while end if elseif x = -1 screen clear box 22 5 22 77 0 0 no-border return (-1) end if end while exit while end while vloadif(dpath|"ent_pord.vw") ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ create/update PURCHORD record and make all assignments ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if upd_new = "NEW" data enter lock elseif upd_new = "UPD" order change key "[Order_Nr]" data find "[Order_Nr]" equal refcode options "" if cerror x = messbox(" Purchase Order not found - cannot update ",1,0,0) return (-1) end if lock-record end if [Supp_Code] = suppcode [Width] = 1 [Length_Quantity] = #ordlength [Balance_OS] = #ordlength [Order_Reference] = ordref [Ordered_By] = orderby [Date_Ordered] = purchorderdate [Product_Code] = prodcode [Order_Nr] = refcode [Delivery_Quoted] = delquot [Comments] = $comment [Last_Update] = today [Updated_By] = userid [Carpet_Color] = desMRC [Order_Cost] = #ordlength [Unit_Cost] = #unitcost [Del] = $del [DelNotes] = $deladdr [Order_Status] = "P" write-record END FUNCTION ' EnterNewOverride() FUNCTION Check_CCW() vloadif(dpath|"colours.vws") $stock = left(prodcode|"’"|desMRC|"’"|"Y"|"’"|str(fixed(#ordwidth,2))|repeat("’",36),36) error off $ccwcode = filelookup([Colours.CodeColourWidth],[Colours.CCW_Code],$stock) if cerror messbox(" New Colour Code being created ",0,0,1) while true increment(dpath|"colours.dat",1) $ccwcode = right("000000"|str(ptval),6) ' create new CCW Code order change key "[CCW_Code]" data find "[CCW_Code]" equal $ccwcode options "" ' check unique if cerror ' if none - then return exit while end if end while data enter lock [Product_Code] = prodcode [CCW_Code] = $ccwcode [CodeColourWidth] = $stock [Width] = #ordwidth [Description_MRC] = desMRC write-record end if return (0) END FUNCTION 'Check_CCW() FUNCTION ChkAllocations() if #reqnrecs > 0 ' if left(jobnr,1) = "C" ' diff routine for Clapham ' error off ' while true ' messbox(" ALL details entered in FULL? (y/n) (No=more to enter later) ",1,1,1) ' if ptstr == "y" ' Warning_C() ' x = messline(" Confirm passed for despatch? (y/n) ",1,0,1,17,7,67) ' if ptstr == "y" ' vloadif(dpath|"cus_ent3b.vw") ' ' vloadif(dpath|"cus_ent8.vw") ' order change key "[Job_Nr]" ' data find "[Job_Nr]" equal jobnr options "" ' if cerror ' if none - then return ' x = messbox(" Job Nr not found - confirm as"&jobnr|"? (y/n) - {Esc} to exit ",1,0,0) ' else ' lock-record ' [Order_Status] = "P" ' write-record ' screen clear box 1 1 sch scw 0 0 no-border ' file unload all ' end if ' exit while ' elseif ptstr == "n" ' not READY ' screen clear box 1 1 sch scw 0 0 no-border ' repaint off ' ' screen shortrestore S_save ' continue while ' end if ' ' elseif ptstr == "n" ' not finished with job more reqns or ' exit while ' ' end if ' end while ' ' else error off while true messbox(" ALL details entered in FULL? (y/n) (No=more to enter later) ",1,1,1) if ptstr == "y" if left(jobnr,1)<>"T" messbox(" Print Worksheet for this job? (y/n) ",1,1,1) if ptstr == "y" ' PrintWorkSheet() end if end if x = messbox(" Do you want to authorise this job? (y/n) ",1,1,1) if ptstr == "y" vloadif(dpath|"cusent3b.vw") order change key "[Job_Nr]" data find "[Job_Nr]" equal jobnr options "" if cerror ' if none - then return x = messbox(" Job Nr not found - confirm as"&jobnr|"? (y/n) - {Esc} to exit ",1,0,0) else lock-record [Order_Status] = "U" write-record end if if left(jobnr,1)="T" ProcessTrade() end if exit while elseif ptstr == "n" ' not READY screen clear box 1 1 sch scw 0 0 no-border repaint off return (1) end if elseif ptstr == "n" ' not finished with job more reqns or screen clear box 1 1 sch scw 0 0 no-border repaint off return (1) end if end while ' end if end if END FUNCTION ' ChkAllocations() FUNCTION PopLengths(r1,c1,br,list,msg,num,mnu) local t hml hm cnum mscn pad padc ret c dc lc sc pl pc fgc bgc fgc = 14 bgc = 1 if exact(trim(list),NULL)=FALSE recs = uistrcnt(list) if recs = 0 return (-3) end if else return (-2) end if redimension plist[recs,3] smartpeek $_l1 hml if br-r1<1 return (-4) elseif br+1 > scrheight mr=scrheight-1 msg = "" else mr=br end if if br >= hml mnu = 0 end if screen save hml 1 hml scrwidth mscn if recs > scrheight if mnu = 1 screen clear box hml 1 hml scrwidth 0 0 no-border screen print hml 1 bgi bgs "Building list..." end if end if ptstr=NULL if mnu = 1 hm = case num (0,"Enter = select/unselect F10 = done Esc = exit") \ (1,"Enter = select Esc = exit (select: 1 item)") \ else "Enter = select/unselect F10 = done Esc = exit " & \ " (select up to:" & str(num) & "items)" else hm = NULL end if sym = spsymmap(28) cnum=0 blen=0 l=blen for c=1 to recs plist[c,2]=group(list,c) l=len(plist[c,2]) plist[c,1]=0 if l>blen blen=l end if end for c2=c1+blen+2 r2=r1+recs if r2>mr r2=mr end if dc=(c2-c1) lc=c1+1 pad = case num (1,1) else 2 sc=c1+pad-1 pl=(r2-r1) padc = repeat(chr(32),pad) for i = 1 to recs pc = 1 plist[i,2]=padc|format(plist[i,2],"r",dc-1) plist[i,3] = i if i = pl pc=pc+1 end if end for if recs > scrheight screen shortrestore mscn end if screen save r1 c1 r2+2 c2+pad psa screen clear box r1 c1 r2+1 c2+pad fgc bgc screen print r1 c1+1 fgc bgc "’Cuts’" pc=1 for c=1 to pl screen print c+r1 lc fgc bgc plist[c,2] end for if msg > null screen print r2+2 c1 fgi bgi str(format(left(msg,dc+pad+1),"M"|str(dc+pad+1))) end if if mnu = 1 screen clear box hml 1 hml scrwidth fgs bgs no-border screen print hml 1 fgs bgs (format(hm,"L"|str(scrwidth))) end if c=1 rec=1 ' screen print r1+c lc fgi bgi plist[rec,2] drows = pl screen save r1 c1 r2+2 c2+1+pad dsa screen shortrestore mscn screen shortrestore psa clear c k dc lc sc recs c2 r2 l blen pl mr pc sym pg i rec tr drows redimension plist[1,3] if trim(ret) = NULL ptstr = NULL return (-1) else ptstr = trim(ret) return (0) end if END FUNCTION 'PopLengths() function refresh(z,r1,c1,r2,c2,pad,b1,b2) local x t screen clear box r1 c1 r2+1 c2+pad b1 b2 drows = 0 for x=0 to pl-1 t = rec-z+x+1 if t > recs exit for else if t > 0 screen print x+1+r1 lc b1 b2 plist[t,2] drows=drows+1 if plist[t,1]=1 screen print x+1+r1 sc b1 b2 sym end if end if end if end for end function 'refresh() function uistrcnt(sl) local i s lo hi c s=20 while exact(group(sl,s),NULL)=FALSE s=s+20 end while hi = s lo = 1 while lo <= hi i = int((lo+hi)/2) c = group(sl,i) if c = NULL hi = i-1 else lo = i+1 end if end while while (exact(group(sl,i),NULL)=TRUE and i>0) i=i-1 end while return (i) end function 'uistrcnt() function udelstr(s,sl) local t i n f f=0 i=0 n=NULL ptstr = NULL while TRUE i=i+1 t = group(sl,i) if exact(t,NULL)=TRUE exit while elseif t = s f=1 else n=n&t end if end while if f = 1 ptstr = trim(n) return (0) end if ptstr = sl return (-1) end function 'udelstr() FUNCTION CheckUsed(cc) local #bal_os #os_reqns #total_os 'find all balances with custcode vloadif(dpath|"cust_ord.vws") order change key "[Customer_Code]" data query execute "cr_limit.dfq" index "custcode.idx" ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' [CustCode] = custcode ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if not (cerror) #bal_os = filesum([Balance_Due]) 'message "#bal_os is:"&str(#bal_os) end if vunloadif("cust_ord.vws") vloadif(dpath|"requsn.vws") data query execute "os_reqns.dfq" index "os_reqns.idx" ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' [Job_Nr] = custcode and not (deleted) ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if not (cerror) #os_reqns = filesum([Retail]) 'message "#os_reqns) is:"&str(#os_reqns) else return(0) end if #total_os = round(#bal_os +#os_reqns,2) 'message "#total_os) is:"&str(#total_os) vunloadif("requsn.vws") return(#total_os) END FUNCTION ' CheckUsed() FUNCTION CheckDelivered(refcode) local origview origview=apinfo(ap_filex) 'message "origview is:"&str(origview) repaint off vloadif(dpath|"chckdeld.vw") order change key "[Requsn_Nr]" data query execute "chkdeld1.dfq" index "deld_1.idx" ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' [Requsn_Nr]=refcode ' and ' not (deleted) ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if cerror vunloadif("chckdeld.vw") vloadif(dpath|origview) return (0) end if #deld = filesum([QuantOut],[Document]<>blank) vloadif(dpath|origview) vunloadif("chckdeld.vw") return (#deld) END FUNCTION 'CheckDelivered() FUNCTION RollorCut() local strtcol strtrow strtcol = 33 strtrow = 9 while true $popstr = $priceterms x = strcount($popstr) if x = 0 #nritems = ptval end if for i = 1 to #nritems y = GROUP($popstr,i) x = len(GROUP($popstr,i)) if x > endcol endcol = x end if end for while true if ASC(specterm) = 0 $popcol = colpopup(strtrow,strtcol,20,$popstr,"",1,0,10,6,0,7) else $popcol = findcolpop(strtrow,strtcol,20,$popstr,"",specterm,1,0,10,6,0,7) if $popcol = -5 $popcol = colpopup(strtrow,strtcol,20,$popstr,"",1,0,10,6,0,7) end if end if if $popcol = 0 exit while end if end while if ptstr = "Other" ' start of price choice loop $length = "C" while true x = entryline(" UNIT PRICE quoted in Sq Metres ",6,nr6,"",21,5,72) if x = 0 #unitcost = value(ptstr) if value(#unitcost) > value($price_C) 'create exception message messline(" This is more than Cut price ("|currency($price_C)|") - confirm (y/n) ",1,0,1,21,5,72) if ptstr == "y" mess = str(#ordlength)|"m of"&prodcode&"ordered at"¤cy(#unitcost)&"from"&suppcode|". Cut price is"¤cy($price_C) x = Exception(userid,today,time24,"P_PRICE",mess) while true x = entryline(" Enter Authorisation code ",6,"","",21,5,72) if x = 0 if ptstr = "" continue while end if priceauthority = ptstr exit while else continue while end if end while specterm = "SPECIAL:"¤cy(#unitcost) exit while else continue while end if end if ' if length is more than 20m, check that price is not greater than ROLL price if value(#ordlength) > 20 if value(#unitcost) > value($price_R) messline(" This is more than normal Roll price - confirm (y/n) ",1,0,1,21,5,72) if ptstr == "y" while true x = entryline(" Enter Authorisation code ",6,"","",21,5,72) if x = 0 if ptstr = "" continue while end if priceauthority = ptstr exit while else continue while end if end while else continue while end if end if end if else continue while end if specterm = "SPECIAL:"¤cy(#unitcost) screen shortrestore dsa exit while end while $length = "O" exit while elseif ptstr = "Cut’Price" if value(#ordlength) > 20 messline(" Length ordered is"&format(str(#ordlength),"2r")&"- confirm CUT price (y/n) ",1,0,1,21,5,72) if ptstr == "n" continue while end if end if #unitcost = $price_C $length = "C" specterm = "CUT:"¤cy(#unitcost) exit while elseif ptstr = "Roll’Price" if value(#ordlength) < 20 messline(" Length ordered is"&format(str(#ordlength),"2r")&"- confirm ROLL price (y/n) ",1,0,1,21,5,72) if ptstr == "n" continue while end if end if #unitcost = $price_R $length = "R" specterm = "ROLL:"¤cy(#unitcost) exit while end if ' end of loop for price choice end while END FUNCTION ' RollorCut() FUNCTION EnterDiscount() repaint off x = popuplist(17,60,23,"Percentage Amount","",1,0) if x = 0 if ptstr = "Amount" while true ' start selection of widths colours etc x = entryline(" Discount on price of"¤cy(#addnVAT)|" (minus for surcharge) ",8,nr8,0,21,5,72) if x = 0 if value(ptstr) = 0 continue while else #addnVAT = #addnVAT-value(ptstr) 'message "#addnVAT is:"&str(#addnVAT) x = messline(" Confirm new price of"¤cy(#addnVAT)|"? (y/n) ",1,1,0,21,5,72) if ptstr == "n" continue while else exit while end if end if exit while elseif x = -1 return (-1) end if end while elseif ptstr = "Percentage" while true x = entryline(" Enter Percentage Discount on price of"¤cy(#addnVAT),6,nr6,0,21,5,72) if x = 0 if value(ptstr) = 0 continue while else #addnVAT = #addnVAT*(100-value(ptstr))/100 x = messline(" Confirm new price of"¤cy(#addnVAT)|"? (y/n) ",1,1,0,21,5,72) if ptstr == "n" continue while else exit while end if end if elseif x = -1 return (-1) end if end while end if elseif x = -1 return (-1) end if #addn=round(#addnVAT/(100+vatrate)*100,2) END FUNCTION ' EnterDiscount() FUNCTION PreparePrice(p,l,w) 'p="T" Trade; p="R" Retail; #ordlength;#ordwidth) local #MU #manfdisc repaint off if p = "T" vloadif(dpath|"custprof.vws") #mu_B = filelookup([ProfCode],[MU_Bespoke],mu_profile) 'message "#mu_B) is:"&str(#mu_B) #mu_A = filelookup([ProfCode],[MU_Ancl],mu_profile) 'message "#mu_A) is:"&str(#mu_A) #mu_C = filelookup([ProfCode],[MU_Stock],mu_profile) 'message "#mu_C) is:"&str(#mu_C) #mu_T = filelookup([ProfCode],[MU_Tiles],mu_profile) 'message "#mu_T) is:"&str(#mu_T) vunloadif("custprof.vws") end if vloadif(dpath|"prodsel"|$prodend|".vw") if p = "T" #MU = case $itemtype ("A",#mu_A)("B",#mu_B)("C",#mu_C)("J",#mu_B)("S",#mu_T)("T",#mu_B)("V",#mu_C)("W",#mu_B)("O",#mu_B) if $length = "R" #price = [SM_List_Rolls] elseif $length = "C" #price = [SM_List_Cuts] elseif $length = "O" #price = #unitcost end if #manfdisc = [Discount_%] 'message "#manfdisc is:"&str(#manfdisc) if #price = 0 #price = [SM_List_Rolls] end if #price = #price*(100-#manfdisc)/100 'message "Price after manf'rs disc is:"&str(#price) #addn = round(value(l)*value(w)*#price*((100+#MU)/100),2) 'message "Price for carpet piece is:"&str(#addn) #addnVAT = round(#addn*((100+vatrate)/100),2) 'message "Price for carpet piece inc VAT ="&str(#addnVAT) elseif p = "R" 'RETAIL PRICES #price = [Retail_Cuts_Metres] 'inc VAT' message "#price is:"&str(#price) #addnVAT = value(l)*value(w)*#price ' message "Price for carpet piece inc VAT ="&str(#addnVAT) #addn = round(#addnVAT*(100/(100+vatrate)),2) ' message "ROUND Price for carpet piece NET is:"&str(#addn) end if END FUNCTION ' PreparePrice() FUNCTION CheckPrice() local z #deflen $wrongprod f1 f2 f3 nr_reqns nr_index upd_new = "NEW" Title_A1() repaint off ptval=0 while true prodcode = "" x = inchar 'message "x is:"&str(x) if x = 316 ' F2 - Stock Carpet - IT = "A" ' $stkcarp = 1 $prodend ="A" while true clearvar() vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"stckcarp.idx" if prodcode = "" y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0) else data goto record record-number #prodrec y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0) end if if x = -1 repaint off y2 = format("Select requisition type or {Esc} to exit","M72") screen print 21 5 fgp bbd y2 vloadif(dpath|"prodsel"|$prodend|".vw") exit while end if #prodrec = record prodcode = ptstr ' message "prodcode -L1430- is:"&str(prodcode) $backing = [Backing] $uos = [Unit_Of_Sale] ' message "$uos is:"&str($uos) screen shortrestore dsa x = Entries(1) if x = -1 screen clear box 5 5 22 77 0 0 no-border screen shortrestore s_shwreq repaint off continue while elseif x = 0 ' new entry made Title_A1() ' message "prodsel|$prodend is:"&str("prodsel"|$prodend) vloadif(dpath|"prodsel"|$prodend|".vw") continue while end if end while elseif x = 317 ' F3 - Bespoke Carpet - IT = "B" $prodend = "B" while true ' bpop must show Supplier name, Suppcode & Backing clearvar() vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"bespcarp.idx" if prodcode = "" y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) else data goto record record-number #prodrec y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) end if if x = -1 repaint off y2 = format("Select requisition type or {Esc} to exit","M72") screen print 21 5 fgp bbd y2 vloadif(dpath|"prodsel"|$prodend|".vw") exit while end if #prodrec = record prodcode = ptstr ' message "prodcode -L1489- is:"&str(prodcode) $backing = [Backing] $uos = [Unit_Of_Sale] ' message "$uos is:"&str($uos) screen shortrestore dsa x = Entries(1) if x = -1 screen clear box 5 5 22 77 0 0 no-border screen shortrestore s_shwreq repaint off continue while elseif x = 0 Title_A1() vloadif(dpath|"prodsel"|$prodend|".vw") continue while end if end while elseif x = 318 ' F4 - Stock Ancl - IT = "A" $prodend = "A" while true ' bpop must show MRC name (& Backing) clearvar() vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"stckancl.idx" if prodcode = "" y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0) else data goto record record-number #prodrec y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0) end if if x = -1 repaint off y2 = format("Select requisition type or {Esc} to exit","M72") screen print 21 5 fgp bbd y2 vloadif(dpath|"prodsel"|$prodend|".vw") exit while end if #prodrec = record prodcode = ptstr $uos = [Unit_Of_Sale] $backing = [Backing] screen shortrestore dsa x = Entries(1) if x = -1 screen clear box 5 5 22 77 0 0 no-border screen shortrestore s_shwreq repaint off continue while elseif x = 0 screen clear box 1 1 sch scw 0 0 no-border Title_A1() vloadif(dpath|"prodsel"|$prodend|".vw") continue while end if end while elseif x = 319 ' F5 - Bespoke Ancl - IT = "J" $prodend = "B" while true ' bpop must show MRC name (& Backing?) & Suppcode clearvar() vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"bespancl.idx" ' message "F5 - prodcode is:"&str(prodcode) if prodcode = "" y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) else data goto record record-number #prodrec y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) end if if x = -1 repaint off y2 = format("Select requisition type or {Esc} to exit","M72") screen print 21 5 fgp bbd y2 vloadif(dpath|"prodsel"|$prodend|".vw") exit while end if #prodrec = record prodcode = ptstr $uos = [Unit_Of_Sale] $backing = [Backing] screen shortrestore dsa x = Entries(1) if x = -1 screen clear box 5 5 22 77 0 0 no-border screen shortrestore s_shwreq repaint off continue while elseif x = 0 Title_A1() vloadif(dpath|"prodsel"|$prodend|".vw") continue while end if end while elseif x = 320 ' F6 - Vinyl - IT = "V or W" $prodend = "B" while true clearvar() vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"vinyl.idx" ' bpop must show MRC ?????????????? if prodcode = "" y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) else data goto record record-number #prodrec y2 = format(" Scroll or press {F3} to search - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"i","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) end if if x = -1 repaint off y2 = format("Select requisition type or {Esc} to exit","M72") screen print 21 5 fgp bbd y2 vloadif(dpath|"prodsel"|$prodend|".vw") exit while end if #prodrec = record prodcode = ptstr $uos = [Unit_Of_Sale] $backing = [Backing] $itemtype= [Item_Type] ' if $itemtype = "V" ' $stkcarp = 1 ' end if screen shortrestore dsa x = Entries(1) if x = -1 screen clear box 5 5 22 77 0 0 no-border screen shortrestore s_shwreq repaint off continue while elseif x = 0 Title_A1() vloadif(dpath|"prodsel"|$prodend|".vw") continue while end if end while elseif x = 321 ' F7 - Tiles - IT = "S or T" $prodend = "B" while true clearvar() vloadif(dpath|"prodsel"|$prodend|".vw") x = popuplist(20,59,25,"Stock Bespoke","",1,0) if x = -1 exit while end if if ptstr = "Stock" order change index ipath|"stk_tile.idx" ' bpop must show MRC ?????????????? else if cr_status = "C" or cr_status = "T" messboxwait(" Cash sale - cannot order Bespoke items ",0,0,1) exit while end if order change index ipath|"bsp_tile.idx" ' bpop must show MRC ?????????????? end if if prodcode = "" y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) else data goto record record-number #prodrec y2 = format(" Scroll or press {F3} to search - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"i","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) end if if x = -1 repaint off y2 = format("Select requisition type or {Esc} to exit","M72") screen print 21 5 fgp bbd y2 vloadif(dpath|"prodsel"|$prodend|".vw") exit while end if #prodrec = record prodcode = ptstr $uos = [Unit_Of_Sale] $backing = [Backing] $itemtype= [Item_Type] ' if $itemtype = "S" ' $stkcarp = 1 ' end if screen shortrestore dsa x = Entries(1) if x = -1 screen clear box 5 5 22 77 0 0 no-border screen shortrestore s_shwreq repaint off Title_C() continue while elseif x = 0 Title_A1() vloadif(dpath|"prodsel"|$prodend|".vw") continue while end if end while elseif x = 763 ' {Esc} - if no records then abandon return (-2) else clearvar() continue while end if end while data goto record last return (0) END FUNCTION ' CheckPrice() FUNCTION Title_A1() y2 = format("Select requisition type or {Esc} to exit","M72") screen print 21 5 fgp bbd y2 screen save 5 5 21 77 s_shwreq repaint off Title_C() END FUNCTION 'Title_A1() FUNCTION clearvar() clear #ordlength clear ordref clear orderby clear purchorderdate clear delquot clear specterm clear prodMRC clear $itemtype clear #reqncost clear $comment clear #ordwidth clear $ccwcode clear $rollnr clear $backing clear $smlc clear $smlr clear $prev_C clear $prev_R clear $effecdate clear $disc clear prodSUPP ' clear suppcode clear #unitcost clear #price clear #addn clear #addnVAT END FUNCTION 'clearvar() FUNCTION OrderedBy() local $save_screen $username while true repaint off vloadif(dpath|"userid.vw") screen save 1 1 sch scw $save_screen $username = userid order change physical order sort now dictionary "x" fields "[author]" ascending x = bpopdb("userid",6,"fp"&$username,"[Name]","L20","[author]","L0","[greeting]",14,16,20,38,"",1) if x = -1 messbox(" Must Select! ",0,0,1) else orderby = [author] screen shortrestore dsa repaint off vunloadif("userid.vw") exit while end if end while END FUNCTION 'OrderedBy()