'ESTIMATE - NEW PROGRAM called from NEW_CUST ' master program for Estimates; enter details or amend/pass notes: a) create subset of CUSTOMER.DB for each shop external fentrybox() messbox() vloadif() dpath scr chkdate() fgi bgi external sch scw progress() fgp bgp messline() popuplist() vkeybox() keybox() external userid entryline() navrecs() messboxwait() base $menu external remove() makeidx() Background() strcount() colpopup() bpopdb() external increment() PrintReport() delstr() dsa addidxrec() vunloadif() external nr6 fdp bbd city delidxrec() ipath vatrate nr8 #m_band4 #m_band5 #m_band6 #m_band1 #m_band2 #m_band3 external band1_UCL band2_UCL band3_UCL band4_UCL band5_UCL band6_UCL external #marginall adhoc_F3 adhoc_F5 adhoc_F6 adhoc_F7 adhoc_F8 exception() external findcolpop() strtoary() ptary[1] lpath wraptext() bge chkstr() public ptstr estnr custname custaddr1 custaddr2 custaddr3 custaddr4 public ftgcomm ptval #ordwidth prodcode #refnr $nextestnr psa custcode public abbrv_name jobnr $ref #netsale #totsale $place global ver count PrintEstimate_C() Title_B() #cost u $opt CopyDetails() global x y1 y2 y i CheckEstNr() cust_title estitem[1,1] $bpop refnr global vat_mu #newgross deladdr1 $partaddr LoadEstimate() #minmarg #actmargin global cat #recnr $unlist $discount #prec Selections() telnr pb global $itemtype prodMRC #prodrec $margincol EnterNewCustomer() $origin global AddItem() y3 s_shwreq $RCM $RRM #saleprice CheckRollPrice() $saltype global $backing $mess1 $smlc $smlr $prev_C $price_R $price_C $newcust global $prev_R $effecdate $disc #ordlength $resvn maxwidth refcode #unitsale global custorderdate #unitcost #reqncost $auth priceauthority tel_locn global mess r2 Entries() $mess2 ChooseWidth() CostingDetails() #newliststck global recs $popstr #nritems strtrow keyf keyb SaveOrPrint() H_tel O_tel global Title_E() ChooseLength() Confirm_yn() upd_new EnterDiscount() global #reqnrec $unit DeleteItem() ReturnToMenu() ProcessEstimate() global z f1 f2 f3 CreateItem() WriteRecord() #percentmargin p7 p8 fentline global $stat p1 p2 p3 p4 p5 p6 #length l pl lc sc rec AlterItem() global #precnr CheckMargin() BCheck() ACheck() n EnterCustName() global #m_100 #m_250 #m_500 #m_1000 #m_2500 #m_over SelectEstimate() global minmargin $branch $uos addn_lab GetData() $check() #newtotal global ReplaceHardSpace() Description() SelectBranch() PrintShopCost() global #marginpercent #newmarginpercent #netsales PrintCustCopy() recnr global S_details RecsScroll() Titles_1() y4 k $status #origtotal global ftginit #startc #startr m1 ftgplan $ordstat $keypress bot $est ShowOrder() username global Job_Locn() s1 s2 s3 s4 s5 s6 s7 ConvertEstimate() MakeOrder() ' MakeReqns() global CreateReqn() $ccwcode ReqnEntries() ChooseColour() $rollnr $increqn global Check_CCW() ConfirmReqn_yn() EnterPurchord() EnterOverride() global EnterColour() ShowBox() strtcol $popcol $stock r1 c1 c2 cl1 cl2 global $newstat #vat $vat lastjob $type $sales #netinv invtot AddVarn() global $allreas $reas1 $reas2 $reas3 $reas4 $reas5 $free $reas $color global CheckDupe() $unsort $prodend $newsort $colorstr EnterNewOrder() global currentorder purchorderdate orderby delquot $comment specterm ordref global $deladdr OrderedBy() EnterNewOverride() NewJobNr() EnterDetails2() ' bot psmode all SearchAddress() ' #m_band4 #m_band5 #m_band6 ' global CustScreenLine() base username $est #m_band1 #m_band2 #m_band3 ' global band1_UCL band2_UCL band3_UCL band4_UCL band5_UCL band6_UCL ' global #pcmargin #marginall adhoc_F3 adhoc_F5 adhoc_F6 adhoc_F7 adhoc_F8 global AbandonEntry() TempProductCode() GetProductCode() EnterDetails() $cat global UpdateProductCode() newcode suppcode suppname SelectUnit() $seltype global PrintInterimOrder() SortColour() jobs[1] $delterms endcol $priceterms global $altref lastsuppcode lastsuppname initbalance ' $backing="NONE" global desMRC SelectType() SelectBacking() tempcode $newcolor $method $del MAIN single-step off Background() error off bot = 7 addn_lab = "L/700106" ' prompts for entry of desc of add'n labour $unlist = "N/103101" ' prompts for desc of unlisted $discount = "N/103100" ' product code for Sales discount vat_mu = 1+(vatrate/100) $reas1="Original’order" $reas2="As’per’attached’order" $reas3="Labour’&’materials’supplied’per’Customer's’order" $reas4="As’per’supporting’documents" $reas5="Free’text" $free ="Labour œxx,xxx - Materials œxx,xxx (exc. VAT)" keyf = 7 keyb = 0 prodcode = "" refcode = "" estnr = "" ' custname = "" cust_title = "" ' deladdr1 = "" custaddr1 = "" custaddr2 = "" custaddr3 = "" custaddr4 = "" telnr = "" ftgcomm = "" base = "W" ' shop dependent - hard coded in progs? ' message "custcode is:"&str(custcode) ' message "custname is:"&str(custname) repaint off ' find all estimates for customer vloadif(dpath|"find_est.vw") order change key "[Customer_Code]" data query execute "statmnt2.dfq" index "est_cust.idx" ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' [Customer_Code] = custcode ' and ' not (deleted) ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if cerror messboxwait(" No estimate yet prepared for"&custname,0,0,1) else SelectEstimate() end if ' while true ' x=ProcessEstimate() ' end while ReturnToMenu() END MAIN FUNCTION ReturnToMenu() file unload all Background() ' transfer cpath|"pm_menu.psl" in-memory END FUNCTION ' ReturnToMenu() FUNCTION Titles_1() local y1 y2 y3 y4 y5 y6 y7 repaint on repaint ptval=0 y1 = format(" Contact names already held on file ","M71") y2 = format(" {A}dd"&chr(34)|custname|chr(34)|" - {S}elect - {Esc} ","M71") screen print 4 6 fgp bgp y1 screen print 21 6 fgp bgp y2 END FUNCTION ' Titles() FUNCTION SearchAddress() vloadif(dpath|"eststat3.vw") data goto record first while true data find "[Delivery_Address_1]" partial $partaddr options "fi" if cerror while true data goto record first data find "[Delivery_Address_2]" partial $partaddr options "fi" if cerror messboxwait(" `"|$partaddr|"' not found in Contacts file ",0,0,1) Background() return (1) else #prec = precord x = ShowOrder() if x = 0 return (0) ' correct found & SEEN! end if end if end while else #prec = precord x = ShowOrder() if x = 0 estnr = [Estimate_Nr] custname = [CustOrd_Name] cust_title = [Title] deladdr1 = [Delivery_Address_1] custaddr1 = [Address1] custaddr2 = [Address2] custaddr3 = [City] custaddr4 = [Code] telnr = [Phone] ftgcomm = [JobDesc] $status = [EstStatus] ' $branch = [Branch] return (0) ' correct found & SEEN! elseif x = -1 return (-1) ' end if end if end while END FUNCTION ' SearchAddress() FUNCTION ShowOrder() vloadif(dpath|"eststat4.vw") data goto record record-number #prec repaint on repaint x = messbox(" Is this the order? (y/n) ",1,1,0) if x = -1 return (-1) else if ptstr == "y" repaint off estnr = [Estimate_Nr] ' jobdesc = [Description] ' ftginstr = [Instructions] ' ftgcomm = [Fitting_Comment] ' jobdesc = @if(len(jobdesc)=0,"Not known",jobdesc) ' ftginstr = @if(len(ftginstr)=0,"Not known",ftginstr) ' ftgcomm = @if(len(ftgcomm)=0,"Not known",ftgcomm) ' slotrec = [Appt_Slots] ' repaint on ' repaint ' $ordstat = [Order_Status] ' screen save 1 1 8 scw S_details repaint off else repaint off progress(15,10," Searching for `"|$partaddr|"' ",0) vloadif(dpath|"eststat3.vw") data goto record next return (1) end if end if END FUNCTION ' ShowOrder() FUNCTION CustScreenLine() repaint on repaint ptval=0 y1 = format(" Name Delivery Address","L71") y2 = format(" {Enter} selects - {Esc} exits ","M71") screen print 5 6 fgp bgp y1 screen print 21 6 fgp bgp y2 END FUNCTION ' CustScreenLine() FUNCTION ReplaceHardSpace(str1) local j r m bw l_last #addn '? bw = 35 ' boxwidth m = "" for j = 1 to len(str1) r = mid(str1,j,1) if r = " " r = "’" ' replace hard space end if m = m|r end for m = m|repeat("’",#addn) '?? return (m) END FUNCTION ' ReplaceHardSpace() FUNCTION RecsScroll() local x bot psmode screen save scrheight 1 scrheight scrwidth bot smartpeek $_spndmes psmode if psmode = 1 smartpoke $_spndmes 0 end if while TRUE x = inchar if x = {Down} data goto record next elseif x = {Up} data goto record previous elseif x = {PgDn} data goto page next elseif x = {PgUp} data goto page previous elseif x = {^End} data goto record last elseif x = {^Home} data goto record first elseif x = {Home} suspendone keys Home,F8 screen shortrestore bot elseif x = {End} suspendone keys End,F8 screen shortrestore bot else exit while end if end while if psmode = 1 smartpoke $_spndmes 1 end if return (x) END FUNCTION ' RecsScroll() FUNCTION AddItem() local z $wrongprod f1 f2 f3 nr_reqns nr_index $m z1 z2 z3 #vat fm ' message "custname is:"&str(custname) #origtotal=filesum([RetailPrice]) Title_E(0) ptval=0 while true #totsale = filesum([RetailPrice]) ' #netsale = filesum([RetailPrice])/((100+vatrate)/100) 'message "#netsale is:"&str(#netsale) ' y1 = format(estnr&"- retail"¤cy(#totsale),"M72") y1 = format(estnr&"Retail"¤cy(#netsale)|"(net) -"¤cy(#totsale)|"(inc VAT)","M72") screen print 5 5 15 12 y1 y2 = format(custname&"/"&estnr,"M72") screen print 4 5 15 12 y2 prodcode = "" ptval = navrecs() if ptval = {U} or ptval = {u} ' UPDATE altering line items; will save as new estimate ' message "$status) is:"&str($status) if right($status,1)="A" messboxwait(" Already accepted - NO alterations permitted ",0,0,1) continue while end if if [Length_Quantity]=0 or [Length_Quantity]=blank continue while else AlterItem() end if $est = "NEW" ACheck() #totsale = filesum([RetailPrice]) ' #percentmargin = ((filesum([RetailPrice])/vat_mu)-filesum([Cost]))/(filesum([RetailPrice])/vat_mu) 'message "#percentmargin) is:"&str(#percentmargin) Title_E(0) elseif ptval = {C} or ptval = {c} 'ACCEPT estimate x=CheckMargin() if x = 1 ' too low messboxwait(" Margin too low - cannot accept estimate ",0,0,1) continue while else x = messbox(" This will be converted into an order - continue? (y/n) ",1,0,1) if ptstr=="n" continue while else ' print order details and ask before continuing" x = messbox(" Check printout before continuing . . . continue? (y/n) ",1,0,1) if ptstr=="n" continue while else u = "A" x=ConvertEstimate() if x = -1 ' abandon continue while else return (2) end if end if end if end if ' x = CostingDetails(u) ' elseif ptval = {S} or ptval = {s} 'elseif x = 68 or x = 100 ' Discount ' if right($status,1)="A" ' messboxwait(" Already accepted - NO alterations permitted ",0,0,1) ' continue while ' end if ' data goto record first ' for i = 1 to records ' if [Product_MRC] ! "Sundry expenses" ' messboxwait(" Removing existing discount entry first! ",0,1,1) ' DeleteItem() ' exit for ' end if ' data goto record next ' end for ' EnterDiscount() elseif ptval = {L} or ptval = {l} $est = "NEW" if right($status,1)="A" messboxwait(" Already accepted - NO alterations permitted ",0,0,1) continue while end if $itemtype = [Item_Type] DeleteItem() ACheck() #percentmargin=((filesum([RetailPrice])/vat_mu)-filesum([Cost]))/(filesum([RetailPrice])/vat_mu) 'message "#percentmargin) is:"&str(#percentmargin) #totsale = filesum([RetailPrice]) 'message "#totsale is:"&str(#totsale) Title_E(0) elseif ptval = {M} or ptval = {m} 'elseif x = 77 or x = 109 ' margin ' fm=abs(filemin([Cost])) ' ' message "fm) is:"&str(fm) ' if fm=0 ' messboxwait(" Cannot show Margin - one or more items not costed ",0,0,1) ' continue while ' end if #percentmargin = ((filesum([RetailPrice])/vat_mu)-filesum([Cost]))/(filesum([RetailPrice])/vat_mu) 'message "#percentmargin) is:"&str(#percentmargin) #totsale = filesum([RetailPrice]) ' #cost = round(filesum([Cost]),2) 'message "#cost is:"&str(#cost) x=CheckMargin() if x = 1 ' too low $margincol = 12 else $margincol = 10 ' OK end if $m = format(#percentmargin,"%1") screen print 1 75 $margincol keyb $m wait .5 screen clear box 1 75 1 scw 0 0 no-border elseif ptval = {F2} 'if x = 316 'F2 - Stock Carpet - IT = "A" if right($status,1)="A" messboxwait(" Already accepted - NO alterations permitted ",0,0,1) continue while end if x = Selections("stckcarp.idx",0,"a") if x = 1 continue while end if BCheck() Title_E(0) elseif ptval = {F3} 'elseif x = 317 ' F3 - Bespoke Carpet - IT = "B" if right($status,1)="A" messboxwait(" Already accepted - NO alterations permitted ",0,0,1) continue while end if $keypress = "F3" x = Selections("bespcarp.idx",1,"b") if x = 1 continue while end if BCheck() Title_E(0) elseif ptval = {F4} 'elseif x = 318 ' F4 - Stock Ancl - IT = "A" if right($status,1)="A" messboxwait(" Already accepted - NO alterations permitted ",0,0,1) continue while end if x = Selections("stckancl.idx",0,"a") if x = 1 continue while end if elseif ptval = {F5} 'elseif x = 319 - F5 - Bespoke Ancl - IT = "J" if right($status,1)="A" messboxwait(" Already accepted - NO alterations permitted ",0,0,1) continue while end if $keypress = "F5" x = Selections("bespancl.idx",1,"b") if x = 1 continue while end if elseif ptval = {F6} 'elseif x = 320 ' F6 - Vinyl - IT = "V or W" if right($status,1)="A" messboxwait(" Already accepted - NO alterations permitted ",0,0,1) continue while end if $keypress = "F6" x = Selections("vinyl.idx",1,"a") if x = 1 continue while end if elseif ptval = {F7} 'elseif x = 321 ' F7 - Tiles - IT = "S or T" if right($status,1)="A" messboxwait(" Already accepted - NO alterations permitted ",0,0,1) continue while end if repaint off $keypress = "F7" while true vloadif(dpath|"est_ent2.vw") error off #refnr = filemax([Ref_Nr]) 'message "#refnr is:"&str(#refnr) if cerror #refnr = 0 end if refcode = estnr|"-"|str(right("00"|str(value(#refnr)+1),2))' vloadif(dpath|"est_sela.vw") x = popuplist(20,59,25,"Stock Bespoke","",1,0) if ptstr = "Stock" order change index ipath|"stk_tile.idx" ' bpop must show MRC ?????????????? else 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("est_sela",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("est_sela",4,"i","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) end if pb = [Product_MRC] 'message "pb is:"&str(pb) if x = -1 repaint off vloadif(dpath|"est_ent2.vw") order change index "current.idx" Title_E(0) exit while end if #prodrec = record prodcode = ptstr 'message "prodcode -L1430- is:"&str(prodcode) screen save 7 43 20 80 $bpop GetData() screen shortrestore dsa x = Entries() 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|"est_ent2.vw") order change index "current.idx" data goto record last Title_E(1) vloadif(dpath|"est_sela.vw") continue while end if end while elseif ptval = {F8} 'elseif x = 322 ' F8 - Fitting - IT = "F" if right($status,1)="A" messboxwait(" Already accepted - NO alterations permitted ",0,0,1) continue while end if $keypress = "F8" x = Selections("labour.idx",0,"a") if x = 1 continue while end if elseif ptval = {F10} 'elseif x = 324 ' F10 - repaint off ' order change physical vloadif(dpath|"est_ent2.vw") if records > 0 screen clear box 22 1 sch scw 0 0 no-border return (0) else ' no reqns entered OR active order change physical return (2) end if elseif ptval = {Esc} ' elseif x = 763 ' {Esc} repaint off #newtotal=filesum([RetailPrice]) if abs(#newtotal-#origtotal)>.01 messboxwait(" Total value has been changed - cannot abandon ",0,0,1) continue while end if messbox(" Abandon? (y/n) ",1,0,1) if ptstr == "y" order change physical return (-1) else continue while end if end if end while data goto record last return (0) END FUNCTION ' AddItem() FUNCTION AlterItem() local #newcost #newretail #oldlength #oldcost #oldretail #length while true #oldlength = [Length_Quantity] 'message "#oldlength is:"&str(#oldlength) #oldcost = [Cost] #oldretail = [RetailPrice] 'message "#oldretail is:"&str(#oldretail) prodMRC = [Product_MRC] $mess2 = " Enter new length/value " if prodMRC ! "Underlay" ' or prodMRC ! "Fitting" #length = filesum([Area],[Item_Type]="B" or [Item_Type]="C") elseif prodMRC ! "Discount" #length = -#oldlength else #length = #oldlength end if x = entryline($mess2,8,nr8,#length,21,5,72) if x = 0 if value(ptstr) = 0 continue 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 = fixed(@if(x "O" $smlc = [SM_List_Cuts] $smlr = [SM_List_Rolls] $RCM = [Retail_Cuts_Metres] $RRM = [Retail_Rolls_Metres] $prev_C = [Prev_SMLC] $prev_R = [Prev_SMLR] $effecdate = [Effect_Date] $disc = [Discount_%] $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 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() if x = -1 ' {Esc} pressed return (-1) elseif x = 1 ' not accepted continue while else return (0) end if else x = ChooseLength() if x = -1 return (-1) end if x = Confirm_yn() if x = -1 ' {Esc} pressed return (-1) elseif x = 1 ' not accepted continue while else return (0) 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]) #ordwidth = 1 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 ' y2 = format(" "|chr(24)&chr(25)|" to choose Width - {Enter} to select ","M72") ' screen print 20 5 fgp bgp y2 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 Confirm_yn() 'Obtain reference & show confirmation box if upd_new = "NEW" #reqnrec = 0 end if repaint off ' ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ' ³ Calculate which Price to use ³ ' ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ ' if days(purchorderdate) < days($effecdate) ' $price_R = round($prev_R*(1-($disc/100)),2) ' $price_C = round($prev_C*(1-($disc/100)),2) ' else ' $price_R = round($smlr*(1-($disc/100)),2) ' $price_C = round($smlc*(1-($disc/100)),2) ' end if ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Calculate which Price to use - (SMLR - disc) at date of order ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if prodcode == $unlist while true x=entryline(" Unit cost of"&prodMRC,10,"","",21,5,72) if x = -1 continue while end if #unitcost = round(ptstr,2) exit while end while end if if prodcode == $unlist while true x=entryline(" Selling price of"&prodMRC&"per unit",10,"","",21,5,72) if x = -1 continue while end if #unitsale = round(ptstr,2) $uos = "U2" exit while end while end if if days(custorderdate) < days($effecdate) #unitcost = round($prev_R*(1-($disc/100)),2) ' ROLL price used for all other prods #unitsale = round($RCM,2) else #unitcost = round($smlr*(1-($disc/100)),2) #unitsale = round($RCM,2) end if ' message "#ordlength) is:"&str(#ordlength) ' message "#ordwidth) is:"&str(#ordwidth) ' message "#unitsale) is:"&str(#unitsale) ' message "$uos) is:"&str($uos) ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Calculate req'n cost ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if $uos = "U3" #reqncost = value(#ordlength) #saleprice = value(#ordlength) elseif $uos = "U1" #reqncost = value(#ordlength)*value(#unitcost) #saleprice = value(#ordlength)*value(#unitsale) elseif $uos = "U2" #reqncost = value(#ordlength)*value(#ordwidth)*value(#unitcost) #saleprice = value(#ordlength)*value(#ordwidth)*value(#unitsale) end if $auth = @if(priceauthority = blank,"None",priceauthority) ' message "#refnr is:"&str(#refnr) if #reqnrec = 0 refcode = estnr|"-"|str(right("00"|str(value(#refnr)+1),2)) 'message "refcode is:"&str(refcode) ' message "refcode is:"&str(refcode) CreateItem() else vloadif(dpath|"est_ent2.vw") while true lock-record [Reference_Nr] = refcode ' assign [Reference_Nr] to record [Est_Nr] = left(refcode,7) [Product_Code] = prodcode [Product_MRC] = prodMRC [Item_Type] = $itemtype [Length_Quantity] = #ordlength [Date_Requisitioned] = today [RetailPrice] = fixed(#saleprice,2) [Cost] = fixed(#reqncost,2) [Width] = #ordwidth [Created/Changed_By] = userid [Branch] = $branch write-record #prec = str(precord) vloadif(dpath|"est_item.vws") order change physical vloadif(dpath|"est_ent2.vw") exit while end while end if END FUNCTION ' Confirm_yn() FUNCTION Title_E(n) ' data goto record first y3 = format(" Description Lngth/val Width Area Retail","L72") repaint on repaint screen print 6 5 fdp bbd y3 Title_B() screen save 5 5 21 77 s_shwreq if n = 1 repaint off end if f1 = format(" F2 ³ F3 ³ F4 ³ F5 ³ F6 ³ F7 ³ F8 ","L80") f2 = format(" Stock ³ Bespoke ³ Stock ³ Bespoke ³ Vinyls ³ Tiles ³ Labour ","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_E() FUNCTION ChooseLength() ' Enter & check Length local f while true if prodcode == $unlist entryline(" Description of item ",35,"","",21,5,72) prodMRC = ptstr elseif prodcode == addn_lab entryline(" What is Additional Labour for? ",35,"","",21,5,72) prodMRC = ptstr end if $mess2 = "Length/quantity/value" if prodMRC ! "Underlay" or prodMRC ! "Fitting" repaint off vloadif(dpath|"est_ent2.vw") #ordlength=filesum([Area],[Item_Type]="B" or [Item_Type]="C") vloadif(dpath|"est_sela.vw") else #ordlength = 0 end if f=left(pb,30) 'message "f) is:"&str(f) $mess2 = $mess2&"of"&f 'message "$mess2 is:"&str($mess2) screen shortrestore $bpop x = entryline($mess2,8,nr8,#ordlength,21,5,72) if x = 0 if value(ptstr) = 0 continue while elseif round(mod(value(ptstr)*100,5),0)=0 or round(mod(value(ptstr)*100,5),0)=5 #ordlength = value(ptstr) CheckRollPrice() exit while else ptstr = value(ptstr) x = round(ptstr*20,0)/20 #ordlength = fixed(@if(x {F10} messbox(" Must use {F10} to save record!! ",0,0,1) continue while end if screen shortrestore ftgplan messline(" Confirm correct and continue? (y/n) ",1,1,1,21,14,53) if ptstr == "y" Background() exit while else continue while end if end while END FUNCTION ' Description() FUNCTION EnterDiscount() local mm newmargin prodMRC = "Discount" $itemtype = "O" prodcode = $discount $uos = "U3" $backing = "NONE" $unit = "Amount" #ordwidth = 1 ' x=filesum([RetailPrice]) ' message "x is:"&str(x) ' x=vat_mu ' message "x is:"&str(x) ' x=filesum([Cost]) ' message "x) is:"&str(x) ' x=filesum([RetailPrice])/vat_mu ' message "x) is:"&str(x) #percentmargin = ((filesum([RetailPrice])/vat_mu)-filesum([Cost]))/(filesum([RetailPrice])/vat_mu) ' ' message "#percentmargin) is:"&str(#percentmargin) #totsale = filesum([RetailPrice]) 'message "#totsale) is:"&str(#totsale) x = popuplist(14,60,23,"Percentage Amount Force’Margin Force’Total","",1,0) if x = 0 if ptstr = "Amount" while true ' start selection of widths colours etc x = entryline(" Enter Discount value ",8,nr8,0,21,5,72) if x = 0 if value(ptstr) = 0 continue while else #ordlength = value(ptstr) exit while end if exit while elseif x = -1 return (-1) end if end while elseif ptstr = "Percentage" while true x = entryline(" Enter Percentage Discount ",6,nr6,0,21,5,72) if x = 0 if value(ptstr) = 0 continue while else #ordlength = #totsale*value(ptstr)/100 exit while end if exit while elseif x = -1 return (-1) end if end while elseif ptstr = "Force’Margin" #actmargin = round(((filesum([RetailPrice])/vat_mu)-filesum([Cost])),2) ' ' message "#actmargin is:"&fixed(#actmargin,2) #cost = round(filesum([Cost]),2) 'message "#cost is:"&str(#cost) ' message "#cost is:"&str(#cost) x=CheckMargin() if x = 0 ' OK minmargin=#percentmargin end if ' message "#percentmargin is:"&str(#percentmargin) ' message "minmargin is:"&str(minmargin) x = entryline(" Enter % Margin req'd (enter to accept minimum) ",6,nr6,fixed(minmargin*100,1),21,5,72) if x = 0 #newmarginpercent = value(ptstr) ' message "#newmargin is:"&str(#newmargin) #cost = filesum([Cost]) #netsales = filesum([RetailPrice])/vat_mu ' message "#netsales is:"&str(#netsales) #marginpercent = 100*((#netsales-#cost)/#netsales) #ordlength = #netsales-(#cost/(1-(#newmarginpercent/100))) #ordlength = round(#ordlength*(1+(vatrate/100)),2) elseif x = -1 return (-1) end if if #ordlength < 0 prodMRC = "Sundry expenses" end if elseif ptstr = "Force’Total" x = entryline(" Enter Sales price (inc VAT) ",8,nr8,0,21,5,72) if x = 0 #newgross = value(ptstr) ' message "#newmargin is:"&str(#newmargin) #totsale = filesum([RetailPrice]) 'message "#netsales is:"&str(#netsales) #ordlength = #totsale-#newgross 'message "new discount inc VAT is:"&str(#ordlength) elseif x = -1 return (-1) end if if #ordlength < 0 prodMRC = "Sundry expenses" end if end if elseif x = -1 return (-1) end if repaint off ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Calculate req'n cost ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ #reqncost = value(#ordlength) #saleprice = value(#ordlength) $auth = @if(priceauthority = blank,"None",priceauthority) #refnr = filemax([Ref_Nr]) 'message "#refnr is:"&str(#refnr) if cerror #refnr = 0 end if if #reqnrec = 0 refcode = estnr|"-"|str(right("00"|str(value(#refnr)+1),2)) 'message "refcode is:"&str(refcode) CreateItem() else vloadif(dpath|"est_ent2.vw") while true lock-record [Reference_Nr] = refcode ' assign [Reference_Nr] to record [Est_Nr] = left(refcode,7) [Product_Code] = prodcode [Product_MRC] = prodMRC [Item_Type] = $itemtype [Length_Quantity] = #ordlength [Date_Requisitioned] = today [RetailPrice] = fixed(#saleprice,2) [Cost] = fixed(#reqncost,2) [Width] = #ordwidth [Created/Changed_By] = userid [Branch] = $branch write-record #prec = str(precord) vloadif(dpath|"est_item.vws") order change physical vloadif(dpath|"est_ent2.vw") exit while end while end if screen clear box 1 1 sch scw 0 0 no-border vloadif(dpath|"est_ent2.vw") order change index "current.idx" data goto record last #percentmargin=((filesum([RetailPrice])/vat_mu)-filesum([Cost]))/(filesum([RetailPrice])/vat_mu) 'message "#percentmargin) is:"&str(#percentmargin) #totsale = filesum([RetailPrice]) 'message "#totsale) is:"&str(#totsale) Title_E(0) END FUNCTION ' EnterDiscount() ' FUNCTION SelectBranch() ' ' message "base is:"&str(base) ' if base="O" ' screen shortrestore dsa ' x = colpopup(8,56,15,"Fulham Raynes Putney Sheen Trade Warehouse","Branch",1,0,10,13,0,7) ' if x = -1 ' return (-1) ' end if ' $branch = left(ptstr,1) ' else ' $branch = left(base,1) ' end if ' END FUNCTION ' SelectBranch() FUNCTION CheckEstNr() fopen dpath|"estimate.dat" as 1 fread 1 into $nextestnr fclose 1 ' message "$nextestnr is:"&str($nextestnr) while true estnr = $branch|"E"|right("00000"|str($nextestnr),5) ' message "estnr is:"&str(estnr) vloadif(dpath|"eststat4.vw") order change key "[Estimate_Nr]" data find "[Estimate_Nr]" equal estnr options "" if cerror ' OK return (0) else messboxwait("’"|estnr&"already used ",0,0,1) $nextestnr=str(val($nextestnr)+1) 'message "$nextestnr is:"&str($nextestnr) end if end while END FUNCTION 'CheckEstNr() FUNCTION CopyDetails() local $newestnr nr_items ' refnr 'copy EST_CUST vloadif(dpath|"est_cust.vws") order change key "[Estimate_Nr]" data find "[Estimate_Nr]" equal estnr options "" custname = [CustOrd_Name] cust_title = [Title] deladdr1 = [Delivery_Address_1] custaddr1 = [Address1] custaddr2 = [Address2] custaddr3 = [City] custaddr4 = [Code] telnr = [Phone] ftgcomm = [JobDesc] $status = [EstStatus] $branch = [Branch] abbrv_name = [Abbrv_Name] $branch = left(estnr,1) $nextestnr = value(right(estnr,5)) 'message "$nextestnr is:"&str($newestnr) while true order change key "[Estimate_Nr]" data find "[Estimate_Nr]" equal estnr options "" if cerror ' if none - then return exit while end if $nextestnr = $nextestnr + 1 estnr = $branch|"E"|right("00000"|str($nextestnr),5) ' end while 'save new EST_CUST data find "[Estimate_Nr]" equal estnr options "" if cerror $status = "AI" ' message "estnr for new record is:"&str(estnr) data enter lock [EstStatus] = $status [Estimate_Nr] = estnr [CustOrd_Name] = custname [Title] = cust_title [Delivery_Address_1] = deladdr1 [Address1] = custaddr1 [Address2] = custaddr2 [City] = custaddr3 [Code] = custaddr4 [Phone] = telnr [Branch] = $branch [JobDesc] = ftgcomm [DateOfEstimate] = today [Invoice_Total] = #totsale [Abbrv_Name] = left(custname,7) [Updated_By] = userid write-record else messboxwait(" Estimate Nr"&estnr&"is already in use ",0,0,1) return (1) end if vloadif(dpath|"est_ent2.vw") nr_items = records ' message "records is:"&str(records) redimension estitem[11,nr_items] ' copy EST_ITEM for i = 1 to nr_items ' message "i is:"&str(i) ' message "refcode is:"&str(refcode) estitem[1,i] = [Reference_Nr] estitem[2,i] = [Est_Nr] estitem[3,i] = [Branch] estitem[4,i] = [Product_Code] estitem[5,i] = [Product_MRC] estitem[6,i] = [Item_Type] estitem[7,i] = [Length_Quantity] estitem[8,i] = [Width] estitem[9,i] = [Cost] estitem[10,i] = [RetailPrice] estitem[11,i] = [Created/Changed_By] ' message "estitem[1,i] is:"&str(estitem[1,i]) ' message "estitem[2,i] is:"&str(estitem[2,i]) ' message "estitem[3,i] is:"&str(estitem[3,i]) ' message "estitem[4,i] is:"&str(estitem[4,i]) ' message "estitem[5,i] is:"&str(estitem[5,i]) ' message "estitem[6,i] is:"&str(estitem[6,i]) ' message "estitem[7,i] is:"&str(estitem[7,i]) ' message "estitem[8,i] is:"&str(estitem[8,i]) ' message "estitem[9,i] is:"&str(estitem[9,i]) ' message "estitem[10,i] is:"&str(estitem[10,i]) ' message "estitem[11,i] is:"&str(estitem[11,i]) data goto record next end for for i = 1 to nr_items refnr= estnr|right(estitem[1,i],3) data enter lock [Reference_Nr] = refnr [Est_Nr] = estnr [Branch] = estitem[3,i] [Product_Code] = estitem[4,i] [Product_MRC] = estitem[5,i] [Item_Type] = estitem[6,i] [Length_Quantity] = estitem[7,i] [Width] = estitem[8,i] [Cost] = estitem[9,i] [RetailPrice] = estitem[10,i] [Created/Changed_By] = estitem[11,i] write-record end for END FUNCTION ' CopyDetails() FUNCTION CheckRollPrice() if $itemtype <> "B" return (1) else if value(#ordlength) > 20 ' message "#ordlength is:"&str(#ordlength) ' message "#RCM is:"&str(#RCM) ' message "#RRM is:"&str(#RRM) x = popuplist(20,12,24,"Cuts Rolls","",1,0) ' ask cuts/rolls ' a2 = lower(left(ptstr,1)) ' $type = left(ptstr,len(ptstr)-1) 'message "$type is:"&str($type) ' $price = "#r"|a2|a1 'message "$price is:"&str($price) ' #price = case $price ("#rcm",#RCMP)("#rcy",#RCYP)("#rrm",#RRMP)("#rry",#RRYP) end if end if END FUNCTION ' CheckRollPrice() FUNCTION EnterNewCustomer() END FUNCTION ' EnterNewCustomer() FUNCTION EnterCustName() local $msg fentline = " Enter Customer's Name (or 1st SEVEN letters if existing customer)" 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|"custsele.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 on file, is"&chr(34)|custname|chr(34)|" a new customer? (y/n)",1,0,1) if ptstr == "y" ' messboxwait(" Add Contact Module not yet functioning ",0,0,1) $newcust = "Y" custcode = jobnr ' return (0) return (-1) end if end if ' repaint on ' repaint ' ptval=0 ' y1 = format(" Contact names already held on file ","M71") ' y2 = format(" {A}dd"&chr(34)|custname|chr(34)|" - {S}elect highlight - {Esc} exits ","M71") ' screen print 4 6 fgp bgp y1 ' screen print 20 6 fgp bgp y2 while true Titles_1() ptval = navrecs() 'message "ptval is:"&str(ptval) if ptval = {S} or ptval = {s} if (deleted) messboxwait(" Deleted record - choose another ",0,0,1) continue while end if ' $origin = [Source] ' message "$origin is:"&str($origin) $newcust = "N" custname = [Customer_Name] abbrv_name = [Abbrv_Name] if len([Address_1]) <> 0 ' Same name ' $msg = custname&"of"&[Address_1]|"?" 'message "len($msg)) is:"&str(len($msg)) ' messbox($msg,1,1,1) ' if ptstr == "y" custcode = [Customer_Code] custaddr1 = [Address_1] H_tel = [Home_Tel] O_tel = [Office_Tel] ' else ' y2 = format(" {A}dd"&chr(34)|custname|chr(34)|" - {S}elect highlight - {Esc} exits ","M71") ' screen print 20 6 fgp bgp y2 ' continue while ' end if repaint off ' return (0) else 'if [Address_1] > 0 end if elseif ptval = {A} or ptval = {a} if $est="OLD" messboxwait(" Cannot add new name for existing costing ",0,0,1) continue while end if messboxwait(" Add Contact Module not yet functioning ",0,0,1) continue while ' messline(" Add"&chr(34)|custname|chr(34)&"to list of Customers? (y/n)",1,1,1,20,6,71) ' if ptstr ! "y" ' $newcust = "Y" ' if x = 0 ' while true ' x = entryline(" Enter Customer's Address - Line 1 ",35,"","",20,6,71) ' if ptstr = "" ' continue while ' end if ' if x = 0 ' custaddr1 = proper(ptstr) ' return (0) ' elseif x = -1 ' return (-1) ' end if ' end while ' exit while ' end if ' else ' exit while ' end if ' repaint off ' return (0) elseif ptval = {Esc} return (-1) else continue while end if if $est = "OLD" x=SelectEstimate() if x=1 continue while end if else return (0) end if end while END FUNCTION 'EnterCustName() FUNCTION SelectEstimate() local lm c1 repaint off vloadif(dpath|"find_est.vw") order change key "[Customer_Code]" data query execute "sel_estm.dfq" index "job_reqn.idx" ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ [Customer_Code] = custcode and not (deleted) ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if cerror ' if none - then return messboxwait(" No estimates found for"&custname,0,0,1) vloadif(dpath|"custsele.vw") return (1) end if ptval=0 while true lm=72 ' message "lm is:"&str(lm) c1=abs(51-(lm/2)) 'message "c1 is:"&str(c1) y1 = format(" "|custname|" ","M72") y3 = format(" Nr Dated Description Amount","L72") y2 = format(" {Enter} to select - {Esc} to finish ","M72") repaint on repaint screen print 4 c1 fgp bgp y1 screen print 5 c1 fgp bgp y3 screen print 25 c1 fgp bgp y2 ptval = navrecs() if ptval = {Enter} if [Status]="A" 'message "L2020 / $status is:"&str($status) messboxwait(" Estimate already accepted - cannot alter ",0,0,1) continue while end if LoadEstimate([Estimate_Nr]) Background() vloadif(dpath|"find_est.vw") elseif ptval = {Esc} repaint off Background() vloadif(dpath|"custsele.vw") return (1) end if end while END FUNCTION ' SelectEstimate() FUNCTION PrintEstimate_C() local m1 m2 m3 while true m1="Shop’costing" m2="Customer's’copy" m3="Both’printouts" repaint off x=popuplist(9,28,13,m1&m2&m3,"",1,0) if x = -1 'ESC return (1) end if if ptstr = m1 PrintShopCost() elseif ptstr = m2 PrintCustCopy() elseif ptstr = m3 PrintCustCopy() PrintShopCost() end if end while END FUNCTION 'PrintEstimate() FUNCTION PrintShopCost() vloadif(dpath|"est_prn1.vw") order change key "[Estimate_Nr]" data find "[Estimate_Nr]" equal estnr options "gw" if cerror ' if none - then return messbox(" Job not found - no estimate printed ",0,0,1) return (-1) else x = remove("printme.idx") x = makeidx("estimate","printme.idx",precord,3) order change index "printme.idx" PrintReport("est_prn3.dfr","Estimate",p3,p4,p5,p6) return (0) end if END FUNCTION 'PrintShopCost() FUNCTION PrintCustCopy() messboxwait(" Insert letterhead paper (no address!) ",0,0,1) vloadif(dpath|"est_prn1.vw") order change key "[Estimate_Nr]" data find "[Estimate_Nr]" equal estnr options "gw" if cerror ' if none - then return messbox(" Job not found - no estimate printed ",0,0,1) return (-1) else x = remove("printme.idx") x = makeidx("estimate","printme.idx",precord,3) order change index "printme.idx" PrintReport("est_prn1.dfr","Estimate",p3,p4,p5,p6) return (0) end if END FUNCTION ' PrintCustCopy() FUNCTION LoadEstimate(nr) Background() quiet on n = 0 vunloadif("est_ent2.vw") if nr = 0 ' NEW estimate' message " NEW estimate" x = CheckEstNr() ' ?get new estimate reference' message "x is:"&str(x) x = remove("current.idx") ' create temp index for allocationmessage "remove x is:"&str(x) x = makeidx("est_item","current.idx","0",1) 'message "x is:"&str(x) vloadif(dpath|"est_ent2.vw") order change index "current.idx" else ' message " EXIST estimate" ' message "nr) is:"&str(nr) estnr = nr vloadif(dpath|"est_ent2.vw") order change key "[Est_Nr]" ' message "estnr is:"&str(estnr) data query execute "est_item.dfq" index "current.idx" ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' [Est_Nr] = estnr ' and ' not (deleted) ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if cerror x = remove("current.idx") ' create temp index for allocation x = makeidx("est_item","current.idx","0",1) order change index "current.idx" end if end if custorderdate = today while true x = AddItem() 'message "x) is:"&str(x) if x = -1 return (-1) elseif x = 2 return (2) ' exit while elseif x = 0 x=CheckMargin() if x = 1 messboxwait(" Low margin - cannot save or print ",0,0,1) continue while end if end if x = SaveOrPrint() if x = 0 increment(dpath|"estimate.dat",1) elseif x = 1 return (0) end if ' message "amend estimate.db record" return (0) end while END FUNCTION 'LoadEstimate() FUNCTION CheckMargin() case when #cost<=band1_UCL 'cost below œ50'message "Cost below"&str(band1_UCL) minmargin = #m_band1 ' FLAT rate when ((#cost>band1_UCL) and (#cost<=band2_UCL)) 'cost between œ50 & œ137.50message "Cost between"&str(band1_UCL)&"and"&str(band2_UCL) minmargin = #m_band1-((#m_band1-#m_band2)*(#cost-band1_UCL)/(band2_UCL-band1_UCL)) when ((#cost >band2_UCL) and (#cost <=band3_UCL)) 'cost between œ137.50 & œ300 minmargin = #m_band2-((#m_band2-#m_band3)*(#cost-band2_UCL)/(band3_UCL-band2_UCL)) when ((#cost >band3_UCL) and (#cost <=band4_UCL)) minmargin = #m_band3-((#m_band3-#m_band4)*(#cost-band3_UCL)/(band4_UCL-band3_UCL)) when ((#cost >band4_UCL) and (#cost <=band5_UCL)) minmargin = #m_band4-((#m_band4-#m_band5)*(#cost-band4_UCL)/(band5_UCL-band4_UCL)) when ((#cost >band5_UCL) and (#cost <=band6_UCL)) minmargin = #m_band5-((#m_band5-#m_band6)*(#cost-band5_UCL)/(band6_UCL-band5_UCL)) when #cost>band6_UCL minmargin = #m_band6 end case if abs(#percentmargin-minmargin)<#marginall 'message "Less than margin allowance" return (0) elseif #percentmargin < minmargin return (1) else return (0) end if END FUNCTION 'CheckMargin() FUNCTION ProcessEstimate() END FUNCTION ' ProcessEstimate() FUNCTION AbandonEntry() 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") END FUNCTION ' AbandonEntry() FUNCTION TempProductCode() ' message "6154//#unitcost is:"&str(#unitcost) 'Itemtype - 6345 'Type - 6128 'Supplier - 6026 'Product - 6110 'Backing - 6131 'Width - 6133 'Unit of Sale - 'Price - 6121 ' EnterItemType() ' select B J T W; use this and increasing nr from "TEMPPROD.DAT" GetProductCode() EnterDetails() END FUNCTION ' TempProductCode() FUNCTION GetProductCode() while true fopen dpath|"tempprod.dat" as 1 ' get next temp prod code fread 1 into ptval fclose 1 prodcode = $cat|"/"|right("000000"|str(ptval),6) clear ptval 'message "prodcode is:"&str(prodcode) repaint off vloadif(dpath|"products.vws") order change key "[Product_Code]" data find "[Product_Code]" equal prodcode options "" if cerror ' if not found then unique exit function ' if not found, proceed with suggested code else UpdateProductCode() end if end while END FUNCTION 'GetProductCode() FUNCTION UpdateProductCode() increment(dpath|"tempprod.dat",1) ' increase counter END FUNCTION ' UpdateProductCode() FUNCTION EnterSupplier() local bpop_ret vloadif(dpath|"new_supp.vw") order change physical order sort now dictionary "suppname" fields "[Name]" ascending ' screen print 19 10 fgi bgi (format("Choose Supplier or {Esc} to enter new","M45")) screen print 19 10 fgi bgi (format("Choose Supplier (existing suppliers only) ","M45")) bpop_ret = bpopdb("new_supp",6,"","[Name]","L35","[Supplier_Code]","L6","[New_Code]",8,10,18,54,"Choose Supplier",0) if bpop_ret = 0 newcode = ptstr suppcode = [Supplier_Code] suppname = [Name] screen clear box 1 1 sch scw 0 0 no-border repaint off ' progress(fgp,bgp," Calculating possible Product Code ",0) elseif bpop_ret = -1 screen clear box 1 1 sch scw 0 0 no-border repaint off return (-1) end if ' if present {Enter} will return [Supplier_Code] or {Esc} will branch ' to entry screen for new SUPPLIER record ' message "suppcode is:"&str(suppcode) ' message "suppname is:"&str(suppname) END FUNCTION ' EnterSupplier() FUNCTION EnterDetails() ' entered on PRODUCTS.DB screen clear box 1 1 sch scw 0 0 no-border repaint off vloadif(dpath|"prodent1.vw") while true EnterSupplier() 'message "suppcode is:"&str(suppcode) while true x = fentrybox(" Enter Product name ",30,"",prodmrc) if x = 0 prodmrc = ptstr x = messbox(" Confirm name is"&prodMRC|"? (y/n) ",1,1,1) if ptstr=="n" continue while end if exit while end if end while SelectUnit() 'message "6159/$unit is:"&str($unit) while true ' message "6265//#unitcost is:"&str(#unitcost) x = fentrybox(" Enter Supplier's net price per"&$unit,8,"*8{[1234567890.]}",#unitcost) if x = 0 #unitcost = val(ptstr) x = messbox(" Confirm net price is"&str(currency(#unitcost))|"? (y/n) ",1,1,1) if ptstr=="n" continue while end if exit while end if end while ' message "6151//#### $cat is:"&str($cat) ' message "$seltype is:"&str($seltype) ' message "$keypress is:"&str($keypress) if $keypress="F5" $seltype="P" $backing="NONE" desMRC="NONE" else SelectType() '########## select product type from options in [Group] SelectBacking() '########## select product type from options in [Group] ' message "6262//$backing is:"&str($backing) while true x = fentrybox(" Enter Colour ",20,"",desMRC) if x = 0 desMRC=ptstr x = messbox(" Confirm colour is"&desMRC&"? (y/n) ",1,1,1) if ptstr=="n" continue while end if exit while end if end while end if while true x = fentrybox(" Enter WIDTH (enter 1 if Width not applicable)",6,nr6,"1") if x = 0 if value(ptstr) = 0 continue while else #ordwidth = value(ptstr) x = messbox(" Confirm width"&fixed(#ordwidth,2)|"? (y/n) ",1,1,1) if ptstr=="n" continue while else exit while end if end if end if end while $itemtype=$cat ' message "prodcode is:"&str(prodcode) ' message "suppcode is:"&str(suppcode) ' message "prodMRC is:"&str(prodMRC) ' message "#unitcost is:"&str(#unitcost) ' message "$seltype is:"&str($seltype) ' message "$itemtype is:"&str($cat) ' message "#ordwidth is:"&str(#ordwidth) ' message "6301//$backing is:"&str($backing) ' message "desMRC is:"&str(desMRC) ' message "$unit is:"&str($unit) vloadif(dpath|"prodent1.vw") data enter lock [Product_Code] = prodcode [Supplier_Code] = suppcode [Product_MRC] = prodmrc [Prod_Cust] = prodmrc [Prev_SMLC] = #unitcost [SM_List_Cuts] = #unitcost [Prev_SMLR] = #unitcost [SM_List_Rolls] = #unitcost [Discount_%] = 0 [Effect_Date] = today [Item_Type] = $cat [Initial_Code] = left(prodcode,1) [Type] = $seltype [Rebranded] = "N" [Markup_Code] = "M3" ' [Group] = "N" [Product_Supplier] = prodMRC [Backing] = $backing [Widths_Available] = #ordwidth [Unit_Of_Sale] = "U2" ' width is 1 even for quantities ' [Unit_Desc] = "Sq metres" [Unit_Desc] = $unit [Re_Order_Level] = 0 [Comments] = "" [Last_Update] = today [Updated_By] = userid [Updated_On] = today [Colours] = desMRC [Temporary] = "Y" write-record tempcode="Y" exit while end while screen clear box 1 1 sch scw 0 0 no-border repaint off END FUNCTION ' EnterDetails() FUNCTION SelectUnit() local d1 d2 d3 d4 d5 while true d1="Quantity" ' d2="Units" ' d3="Metres" d4="Lin’Metre" ' d4="Lin Metre" d5="Sq’Metre" ' d5="Sq Metre" x = popuplist(10,39,25,d5&d4&d1,"Select Units",1,0) $unit = ptstr messbox(" Confirm Unit Description is"&$unit&"? (y/n) ",1,1,1) ' $unit = ptstr if ptstr == "y" exit while else continue while end if end while END FUNCTION ' SelectUnit() FUNCTION SelectType() local t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 while true t1="Twist" t2="Velvet" t3="Natural" t4="Saxony" t5="Wood" t6="Lino" t7="Domestic Vinyl" t8="Rugs" t9="Other" t10="N/A" t11="Pattern" ' x = popuplist(10,39,25,t1&t2&t3&t4&t5&t6&t7&t8&t9&t10&t11,"Select Type",1,0) x = popuplist(10,39,25,t1&t2&t3&t4&t8&t9&t11,"Select Type",1,0) $seltype=ptstr messbox(" Confirm Product Category is"&$seltype&"? (y/n) ",1,1,1) if ptstr == "n" continue while end if if $seltype=t1 $seltype="Z" elseif $seltype=t2 $seltype="Y" elseif $seltype=t3 $seltype="X" elseif $seltype=t4 $seltype="W" elseif $seltype=t5 $seltype="V" elseif $seltype=t6 $seltype="U" elseif $seltype=t7 $seltype="T" elseif $seltype=t8 $seltype="S" elseif $seltype=t9 $seltype="R" elseif $seltype=t10 $seltype="P" elseif $seltype=t11 $seltype="N" end if exit while end while END FUNCTION ' SelectType() FUNCTION SelectBacking() while true while true x = popuplist(10,55,21,"JUTE FOAM GELL IMPV FELT VINY WAFF LATX STND OVER NONE","Backing",1,0) ' message "x is:"&str(x) if x = 0 $backing = ptstr exit while elseif x = -1 continue while end if end while messbox(" Confirm Backing is"&$backing&"? (y/n) ",1,1,1) if ptstr == "y" exit while else continue while end if end while END FUNCTION ' SelectBacking() FUNCTION SelectBranch() local leftjob currec s1 = "Warehouse" s2 = "Trade" s3 = "Fulham" s4 = "Raynes" s5 = "Sheen" s7 = "Putney" if base="O" ' choice of Warehouse etc leftjob=Job_Locn() elseif base="F" while true x = popuplist(8,57,15,s3&S7&s2,"Estimate",1,0) if x = -1 continue while end if $place = ptstr messbox(" Confirm"&upper($place)&"estimate? (y/n) ",1,1,1) if ptstr == "y" leftjob=left($place,1) exit while else continue while end if end while elseif base="S" while true x = popuplist(8,57,15,s5&s4,"Estimate",1,0) if x = -1 continue while end if $place = ptstr messbox(" Confirm"&upper($place)&"estimate? (y/n) ",1,1,1) if ptstr == "y" leftjob=left($place,1) exit while else continue while end if end while else leftjob=Job_Locn() end if END FUNCTION 'SelectBranch() FUNCTION Job_Locn() s1 = "Warehouse" s2 = "Trade" s3 = "Fulham" s4 = "Raynes" s5 = "Sheen" s7 = "Putney" while true x = popuplist(8,37,15,s3&s7&s4&s5&s2&s1,"Estimate",1,0) if x = -1 continue while end if $place = ptstr messbox(" Confirm"&upper($place)&"estimate? (y/n) ",1,1,1) if ptstr == "y" return (left($place,1)) else continue while end if end while END FUNCTION 'Job_Locn() FUNCTION ConvertEstimate() ' message "check details esp price" ' message "enter customer's acceptance ref" ' message " confirm Acceptance" ' message " mark as accepted" ' message " enter Order on system" x=MakeOrder() ' message "convert est_items to requ'ns" ' x=MakeReqns() END FUNCTION 'ConvertEstimate() FUNCTION MakeOrder() local response prec# y Background() repaint off x = keybox("1Normal 1Zero’rate","Enter type of Sale") ' if x = -1 ' return (-1) ' end if $saltype = ptstr ' message "$saltype is:"&str($saltype) ' $saltype = "n" r1 = 8 r2 = r1+6 c1 = 17 c2 = c1+48 cl1 = 14 cl2 = 3 $newstat = "A" $method = "Cheque" if $saltype == "n" #vat = vatrate $vat = "S" elseif $saltype == "z" $vat = "Z" #vat = 0 end if ' message "custname is:"&str(custname) ' x = EnterCustName() if x = -1 return (1) end if ' progress(15,10," Please wait ... checking Job Nr ",0) vloadif(dpath|"cust_ord.vws") order change key "[Job_Nr]" ' data find "[Job_Nr]" equal jobnr options "" ' if cerror ' if none - then return ' else ' messbox(" Job Nr"&jobnr&"already used, creating another ",0,1,1) ' while true ' lastjob=right(jobnr,5) ' jobnr=left(jobnr,1)|right("00000"|str(value(lastjob)+1),5) 'message "jobnr is:"&str(jobnr) ' data find "[Job_Nr]" equal jobnr options "" ' if cerror ' if none - then return ' exit while ' else ' continue while ' end if ' end while ' end if NewJobNr() ' message "L2595-jobnr is:"&str(jobnr) ' message "custname) is:"&str(custname) ' message "deladdr1) is:"&str(deladdr1) ' message "$vat) is:"&str($vat) ' message "userid) is:"&str(userid) vloadif(dpath|"find_est.vw") lock-record [Status]="A" [JobNr] =jobnr write-record deladdr1=[DeliveryAddress1] custcode=[Customer_Code] invtot =[Amount] ' message "invtot is:"&str(invtot) vloadif(dpath|"cust_ord.vws") data enter lock [Job_Nr] = jobnr [Branch] = left(jobnr,1) [CustOrd_Name] = custname [Delivery_Address_1] = deladdr1 [Abbrv_Name] = left(custname,7) [Date_Of_Order] = today [VAT] = $vat [Updated_By] = userid [Last_Update] = today ' [Parent] = $parent [Customer_Code] =custcode [Completed] = "N" [PDA] = "Y" [Origin] = estnr write-record ' data goto record record-number recnr ' lock-record ' [SalesAnalysis] = $sales ' [Type_Branch] = $type ' [Invoice_Total] = 0 ' [Net_Invoice] = 0 ' [Balance_Due] = 0 ' [Order_Status] = $newstat ' write-record recnr = precord ' EnterDetails2() vloadif(dpath|"cust_ord.vws") $type = case left(jobnr,1)("C","S")("R","S")("S","S")("F","S")("P","F")("W","H")("T","H")("Y","H") $sales = case left(jobnr,1)("C","X")("R","R")("S","S")("F","F")("P","P")("W","W")("T","T")("Y","Y") if len(custname) = 0 messboxwait(" Customer's name has been omitted - pls contact David @ HO ",0,0,1) end if if len(abbrv_name) = 0 messboxwait(" Customer's abbrv'd name has been omitted - pls contact David @ HO ",0,0,1) end if #netinv = round(invtot*100/(100+#vat),2) data goto record record-number recnr lock-record [SalesAnalysis] = $sales [Type_Branch] = $type [Delivery_Address_1] = deladdr1 [Invoice_Total] = 0 [Net_Invoice] = 0 [Balance_Due] = 0 [Customer_Code] = custcode [Updated_By] = userid [Last_Update] = today [Order_Status] = $newstat [PDA] = "Y" [Origin] = $origin [Completed] = "N" write-record recnr = precord $status = "A" if $menu = "boss" $allreas = $reas1&$reas2&$reas3&$reas4&$reas5 else $allreas = $reas1&$reas2&$reas3&$reas4 end if while true x = popuplist(8,15,14,$allreas,jobnr,1,0) if x = -1 continue while elseif x = 0 exit while end if end while if ptstr = $reas5 while true x = entryline(" Variation description - the Customer reads this! ",50,"",$free,21,6,71) if x = -1 return (-1) elseif x = 0 if ptstr = "" continue while end if $reas = ptstr exit while end if end while else $reas = ptstr end if AddVarn(jobnr|"-00",invtot,$reas,"Original","Original",today) Background() messbox(" Print interim confirmation? (y/n) ",1,1,1) if ptstr == "y" PrintInterimOrder() end if ' AddToArray() END FUNCTION ' MakeOrder() FUNCTION Conv2Reqns() ' find all items for i=1 to precords ReqnEntries() ' data goto record next end for ' step thru entering colours END FUNCTION 'Conv2Reqns() FUNCTION ReqnEntries() if tempcode="N" ' 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 ' message "929/$itemtype is:"&str($itemtype) while true ' start selection of widths colours etc x = ChooseColour() if x = -1 return (-1) elseif x = 2 ' new colour continue while end if ' x = ChooseWidth() ' if x = -1 ' return (-1) ' end if if $itemtype = "B" or $itemtype = "C" ' messbox(" Are there duplicate entries to be made out? (y/n) ",1,1,1) ' if ptstr == "y" ' x = MultipleCuts() ' if x = -1 ' {Esc} pressed ' return (-1) ' elseif x = 1 ' not accepted ' continue while ' else ' return (0) ' end if ' ' else ' x = ChooseLength() ' if x = -1 ' return (-1) ' end if ' end if x = Confirm_yn() if x = -1 ' {Esc} pressed return (-1) elseif x = 1 ' not accepted continue while else return (0) end if else ' if NOT $itemtype = "B" or $itemtype = "C" ' x = ChooseLength() ' if x = -1 ' return (-1) ' end if ' x = Confirm_yn() ' if x = -1 ' {Esc} pressed ' return (-1) ' elseif x = 1 ' not accepted ' continue while ' else ' return (0) ' end if end if end while else ' tempcode="Y" while true if $itemtype = "B" or $itemtype = "C" ' messbox(" Are there duplicate entries to be made out? (y/n) ",1,1,1) ' if ptstr == "y" ' x = TempCodeMultiCuts() ' if x = -1 ' {Esc} pressed ' return (-1) ' elseif x = 1 ' not accepted ' continue while ' else ' return (0) ' end if ' else ' x = ChooseLength() ' if x = -1 ' return (-1) ' end if ' end if x = Confirm_yn() if x = -1 ' {Esc} pressed return (-1) elseif x = 1 ' not accepted continue while else return (0) end if else ' if NOT $itemtype = "B" or $itemtype = "C" ' x = ChooseLength() ' if x = -1 ' return (-1) ' end if ' x = Confirm_yn() ' if x = -1 ' {Esc} pressed ' return (-1) ' elseif x = 1 ' not accepted ' continue while ' else ' return (0) ' end if end if end while end if END FUNCTION ' Entries() FUNCTION BespStatus() vloadif(dpath|"chk_stat.vw") order change key "[Job_Nr]" data find "[Job_Nr]" equal jobnr options "" lock-record [Recd_Status]="P" write-record END FUNCTION ' BespStatus() 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 WriteReqn() ' 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 "#ordwidth is:"&str(#ordwidth) ' message "$ccwcode is:"&str($ccwcode) ' message "$rollnr is:"&str($rollnr) ' message "513//$backing is:"&str($backing) ' message "#prodrec is:"&str(#prodrec) 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] = fixed(#reqncost,2) [Cost_OS] = fixed(#reqncost,2) [Comment] = $auth [Width] = #ordwidth [Created/Changed_By] = userid [CCW_Code] = $ccwcode [RollNr] = $rollnr [R_Backing] = $backing [prodrec] = #prodrec write-record $increqn = "Y" UpdateProductCode() ' message "Prodcode nr updated" ' if itemtype is bespoke, then [cust_ord.Recd_Status] must be "P" #precnr = precord if $itemtype = "C" x = addidxrec("allocn.idx",#precnr,7) ' StockStatus() elseif $itemtype = "B" BespStatus() elseif $itemtype = "J" BespStatus() elseif $itemtype = "O" BespStatus() elseif $itemtype = "T" BespStatus() elseif $itemtype = "W" BespStatus() end if vloadif(dpath|"cus_ent4.vw") order change physical x = addidxrec("current.idx",#precnr,7) 'message "addidxrec @ L779 is:"&str(x) order change index "current.idx" 'message "records is:"&str(records) return (0) END FUNCTION 'WriteReqn() 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 WriteRecord() ' entry order if prodMRC = "Commission" ' message "enter record in GDS_RCVD file" ' CommissionRcvd() end if #ordlength = 0 exit while end while END FUNCTION ' CreateReqn() FUNCTION ConfirmReqn_yn() 'Obtain reference & show confirmation box if upd_new = "NEW" #reqnrec = 0 end if ' 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 = " 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 = EnterPurchord() ' returns #unitcost 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 ' elseif $backing = "COMM" ' x = EnterCommission() ' ' 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 ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ 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 $auth = @if(priceauthority = blank,"None",priceauthority) if #reqnrec = 0 CreateReqn() else vloadif(dpath|"cus_ent7.vw") ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Assign revised figures to REQUSN & PURCHORD ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ ' $ccw = prodcode&desMRC&"Y"&str(format(#ordwidth,"2r")) if $itemtype = "C" $rollnr = "00000/00" elseif $itemtype = "B" $rollnr = "BESPOK" else $rollnr = "NA" end if ' message "1725-prodcode is:"&str(prodcode) 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] = fixed(#reqncost,2) [Comment] = $auth [Width] = #ordwidth [Created/Changed_By] = userid [CCW_Code] = $ccwcode [RollNr] = $rollnr [R_Backing] = $backing [prodrec] = #prodrec write-record ' UpdGdsOut($rollnr,refcode) #prec = str(precord) vloadif(dpath|"requsn.vws") order change physical vloadif(dpath|"cus_ent4.vw") exit while end while end if END FUNCTION ' Confirm_yn() 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 screen clear box 1 56 1 80 0 0 no-border 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 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 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 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 AddVarn(varnr,#gross,$reas,$ref,$notif,$varndate) local balancedue lastbal newtotal oldtotal newnet oldnet #prec x vloadif(dpath|"addvarn3.vw") data enter lock [Var_Nr] = varnr [VarnJobNr] = left(varnr,6) [Amount_Gross] = #gross [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+#vat),2) lock-record [Balance_Due] = balancedue [Invoice_Total] = newtotal [Net_Invoice] = newnet write-record END FUNCTION 'AddVarn() FUNCTION PrintInterimOrder() local $index $file scrn scrn=apinfo(ap_filex) 'message "Screen is:"&str(x) Background() vloadif(dpath|"intorder.vw") data goto record record-number recnr $index = "onlyone.idx" $file = "cust_ord" remove($index) x = makeidx($file,$index,str(precord),3) ' message "x is:"&str(x) order change index $index p3 = 1 ' p1 = "INTORDER.dfr" ' p1 = report definition ("ord_stck.dfr") PrintReport(p1,p2,p3,p4,p5,p6) vloadif(dpath|scrn) END FUNCTION ' PrintInterimOrder() FUNCTION NewJobNr() local leftjob currec ' s1 = "Warehouse" ' s2 = "Trade" ' s3 = "Fulham" ' s4 = "Raynes" ' s5 = "Sheen" ' s7 = "Putney" ' ' if base="O" ' choice of Warehouse etc ' leftjob=Job_Locn() ' ' elseif base="F" ' while true ' x = popuplist(8,57,15,s3&S7&s2,"Order",1,0) ' if x = -1 ' continue while ' end if ' $place = ptstr ' messbox(" Confirm"&upper($place)&"job? (y/n) ",1,1,1) ' if ptstr == "y" ' leftjob=left($place,1) ' exit while ' else ' continue while ' end if ' end while ' ' ' messbox(" Confirm FULHAM job? (y/n) ",1,1,1) ' ' if ptstr == "y" ' ' leftjob = base ' ' else ' ' leftjob=Job_Locn() ' ' end if ' ' elseif base="S" ' while true ' x = popuplist(8,57,15,s5&s4,"Order",1,0) ' if x = -1 ' continue while ' end if ' $place = ptstr ' messbox(" Confirm"&upper($place)&"job? (y/n) ",1,1,1) ' if ptstr == "y" ' leftjob=left($place,1) ' exit while ' else ' continue while ' end if ' end while ' messbox(" Confirm SHEEN job? (y/n) ",1,1,1) ' if ptstr == "y" ' leftjob = base ' else ' leftjob=Job_Locn() ' end if ' else ' leftjob=Job_Locn() ' end if leftjob = left(estnr,1) 'message "leftjob) is:"&str(leftjob) vloadif(dpath|"cust_ord.vws") data goto record last while true if left([Job_Nr],1)=leftjob lastjob=right([Job_Nr],5) jobnr=leftjob|right("00000"|str(value(lastjob)+1),5) currec=precord data find "[Job_Nr]" equal jobnr options "g" if cerror ' if none - then return exit while else data goto record record-number currec data goto record previous end if else data goto record previous end if end while END FUNCTION 'NewJobNr() FUNCTION AddToArray() local $new $newcust $hold h y = strtoary(custname) $newcust = "" for i = 1 to ptval if i = 1 $newcust = ptary[i] ' NB - space is Alt-255 else $newcust = $newcust|"’"|ptary[i] ' NB - space is Alt-255 end if end for $new = jobnr|"’"|$newcust ' HARD space for i = 1 to 6 if left(jobs[i],6) = jobnr ' jobnr already held $hold = jobs[i] for h = i-1 to 1 step -1 if len(jobs[h]) = 0 jobs[h+1] = "" else jobs[h+1] = jobs[h] end if end for jobs[1] = $hold return (0) end if end for for i = 5 to 1 step -1 if len(jobs[i]) = 0 jobs[i+1] = "" else jobs[i+1] = jobs[i] end if end for redimension ptary[6] jobs[1] = $new for i = 1 to 6 ptary[i] = jobs[i] end for END FUNCTION ' AddToArray() 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 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 EnterPurchord() ' If $itemtype = "B", check Purchase Order entered ' message "1573/suppcode is:"&str(suppcode) ' message "1573/suppname is:"&str(suppname) 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 EnterNewOrder() local mess oldstrt ordref = "" specterm = "" 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 while true while true ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ 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 ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Calculate which Price to use ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if days(purchorderdate) < days($effecdate) $price_R = round($prev_R*(1-($disc/100)),2) $price_C = round($prev_C*(1-($disc/100)),2) else $price_R = round($smlr*(1-($disc/100)),2) $price_C = round($smlc*(1-($disc/100)),2) end if ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ 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 ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Enter Cost Code ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ ' message "tempcode is:"&str(tempcode) if tempcode="Y" 'price already known else oldstrt = strtrow while true $popstr = $priceterms x = strcount($popstr) if x = 0 #nritems = ptval else end if strtrow = oldstrt - 2 - #nritems 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(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 screen shortrestore dsa 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 normal Cut price - 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 exit while elseif ptstr = "Cut’Price" screen shortrestore dsa 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 specterm = "CUT:"¤cy(#unitcost) exit while elseif ptstr = "Roll’Price" screen shortrestore dsa 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 specterm = "ROLL:"¤cy(#unitcost) exit while end if ' end of loop for price choice end while end if ' message "#unitcost is:"&str(#unitcost) vloadif(dpath|"supplier.vws") ' message "2702/suppcode is ####:"&str(suppcode) suppname = filelookup([Supplier_Code],[Name],suppcode) ' message "2702/suppname is ####:"&str(suppname) 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 = "I" 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) x = messline("’"|fixed(#ordlength,2)&$unit&"ordered by"&orderby&"on"&purchorderdate&"? (y/n) ",1,0,1,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 ' message "####2799/suppcode is:"&str(suppcode) 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 [JobNr] = jobnr [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 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() 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 ' message "#####3034 /lastsuppname is:"&str(lastsuppname) ordref = "" specterm = "" suppcode = lastsuppcode suppname = lastsuppname ' message "suppname is:"&str(suppname) ' message "suppcode is:"&str(suppcode) 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) ",1,0,1,21,5,72) if x = 0 if ptstr == "y" repaint off exit while end if 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 ' message "####3169 - lastsuppcode is:"&str(lastsuppcode) [JobNr] = jobnr [Supp_Code] = lastsuppcode [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] = #reqncost [Unit_Cost] = #unitcost [Del] = $del [DelNotes] = $deladdr [Order_Status] = "P" write-record END FUNCTION ' EnterNewOverride() FUNCTION EnterDetails2() vloadif(dpath|"custsel4.vw") data find "[Customer_Code]" equal custcode options "" ' if cerror ' if none - then return ' x = messbox(" Job Nr not found - confirm as"&jobnr|"? (y/n) - {Esc} to exit ",1,0,0) ' if x = 0 ' @if(len(deladdr1)=0,"",deladdr1) while true while true x = entryline(" Confirm Delivery Address - Line 1 ",35,"",deladdr1,21,6,71) if ptstr = "" continue while end if if x = 0 deladdr1 = proper(ptstr) ' if $newcust = "Y" ' SelectOrigin() ' else ' end if exit while elseif x = -1 continue while end if end while screen clear box r1 c1 r2 c2 cl1 cl2 y1 = format(" "|jobnr&"-"&custname|" ","M46") screen print r1+1 c1+2 cl1 cl2 y1 y1 = format(" Fit at:"&deladdr1,"L46") screen print r1+2 c1+2 cl1 cl2 y1 if $newcust = "Y" while true x = popuplist(9,66,13,"Home Office None","",1,0) if x = 0 tel_locn = ptstr exit while else continue while end if end while if tel_locn <> "None" while true x = entryline(" Enter"&tel_locn&"telephone number e.g. 020-8947-5432 ",15,"\0*14{[1234567890\-]}",telnr,21,6,71) screen clear box 20 1 21 scw 0 0 no-border if x = 0 if ptstr = "0" continue while end if telnr = ptstr exit while else continue while end if end while else telnr = "0 - No Nr" end if y3 = format(" "|tel_locn&"Telephone:"&telnr,"L46") screen print r1+5 c1+2 cl1 cl2 y3 else ' lookup existing nrs H_tel = [Home_Tel] O_tel = [Office_Tel] if len(H_tel) > 0 x = entryline(" Confirm Home telephone number ",15,"\0*14{[1234567890\-]}",H_tel,21,6,71) if x = 0 H_tel = ptstr end if end if if len(O_tel) > 0 x = entryline(" Confirm Office telephone number ",15,"\0*14{[1234567890\-]}",O_tel,21,6,71) if x = 0 O_tel = ptstr end if end if y3 = format(" Home:"&H_tel|" Office:"&O_tel,"L46") screen print r1+5 c1+2 cl1 cl2 y3 end if y2 = format(" Date ordered:"&date2(today),"L46") screen print r1+3 c1+2 cl1 cl2 y2 initbalance = invtot y3 = format(" Order value:"¤cy(invtot)&"(inc. VAT @"&str(#vat)|"%) ","L46") screen print r1+4 c1+2 cl1 cl2 y3 screen clear box 20 1 21 scw 0 0 no-border vloadif(dpath|"custsel4.vw") x = messline(" Confirm correct and continue with Order? (y/n) ",1,1,1,21,6,71) if ptstr == "y" repaint off if $newcust = "Y" repaint off custcode = jobnr if len(custname) = 0 messboxwait(" Customer's name has been omitted - pls contact David @ HO ",0,0,1) end if if len(abbrv_name) = 0 messboxwait(" Customer's abbrv'd name has been omitted - pls contact David @ HO ",0,0,1) end if data enter lock [Branch] = left(custcode,1) ' [Parent] = "M" [Customer_Name] = custname [Abbrv_Name] = abbrv_name [Customer_Code] = custcode [Profile] = "A" [Credit_Status] = "C" if left(tel_locn,1) = "H" [Home_Tel] = telnr elseif left(tel_locn,1) = "O" [Office_Tel] = telnr else telnr = "None" end if [Updated_By] = userid [Last_Update] = today [ChkAddr] = "Y" [Source] = $origin write-record ' $parent="M" else lock-record [Home_Tel] = H_tel [Office_Tel] = O_tel write-record ' $parent="M" end if return (0) else continue while end if repaint off end while END FUNCTION 'EnterDetails2()