'ESTIMATE - master program for Estimates; enter details or amend/pass 'notes: a) create subset of CUSTOMER.DB for each shop '11/04/04 - temp prod code system external fentrybox() messbox() vloadif() dpath scr chkdate() fgi bgi external sch scw progress() fgp bgp messline() popuplist() vkeybox() keybox() external userid cpath entryline() navrecs() messboxwait() base external remove() makeidx() Background() strcount() colpopup() bpopdb() external increment() PrintReport() delstr() dsa addidxrec() 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 public ptstr estnr custname custaddr1 custaddr2 custaddr3 custaddr4 public ftgcomm ptval #ordwidth prodcode #refnr $nextestnr psa custcode public abbrv_name jobnr $ref #netsale #totsale 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() global S_details RecsScroll() Titles_1() y4 k $status #origtotal global ftginit #startc #startr m1 ftgplan $ordstat $keypress bot $est ShowOrder() username ' global 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 ' $backing="NONE" global desMRC SelectType() SelectBacking() tempcode MAIN single-step off Background() error off bot = 7 $branch="W" p2 = "" ' p2 = title at top of choice popup ("LABEL") p3 = 1 ' p3 = printer to be used (1=HPIII_QC; 2=GEN_EPSN etc) p4 = 1 p5 = 1 ' p5 = choose VIEW/PRINT 1=PRINT; 2=VIEW; 3=CHOOSE p6 = 1 ' p6 = nr of copies 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 ' #m_band1 = .50 ' margin for Band 1 ' #m_band2 = .45 ' #m_band3 = .40 ' #m_band4 = .32 ' #m_band5 = .30 ' #m_band6 = .28 ' ' band1_UCL=50 ' upper cost limit for Band 1 ' band2_UCL=137.50 ' band3_UCL=300 ' band4_UCL=680 ' band5_UCL=1750 ' band6_UCL=2880 ' ' adhoc_F3=1.68 ' adhoc_F5=2 ' adhoc_F6=1.85 ' adhoc_F7=1.85 ' adhoc_F8=1.68 vat_mu = 1+(vatrate/100) ' #marginall = .01 ' ie 1% 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? ' messboxwait(" N.B. hard-coded for WAREHOUSE ",0,0,1) while true Background() x=popuplist(9,28,13,"Existingÿestimate ÿÿNewÿestimate","",1,0) if x = -1 'ESC ReturnToMenu() end if if ptstr = "Existingÿestimate" $est = "OLD" x=EnterCustName() if x=-1 Background() continue while end if else $est = "NEW" x=EnterCustName() if x=-1 Background() continue while end if LoadEstimate(0) vloadif(dpath|"find_est.vw") end if end while 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 #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 prodcode = "" ptval = navrecs() if ptval = {U} or ptval = {u} ' UPDATE 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 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) ' $margincol = 12 else ' $margincol = 10 ' OK end if u = "A" x = CostingDetails(u) if x = -1 continue while end if ' check details esp price ' confirm Acceptance ' mark as accepted 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} 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 #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 ' ' 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 ' return (2) ' end if #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,6) [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(17,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,6) [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() 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 y1 = format(" "|custname|" ","M69") y3 = format(" Nr Dated Description Amount","L69") y2 = format(" {Enter} to select - {Esc} to finish ","M69") repaint on repaint screen print 5 5 fgp bgp y1 screen print 6 5 fgp bgp y3 screen print 22 5 fgp bgp y2 ptval = navrecs() if ptval = {Enter} LoadEstimate([Estimate_Nr]) Background() vloadif(dpath|"find_est.vw") elseif ptval = {Esc} repaint off Background() vloadif(dpath|"custsele.vw") ' order change key "[Abbrv_Name]" 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() ' file unload all quiet on n = 0 ' message "nr is:"&str(nr) 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 allocation ' message "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" estnr = nr vloadif(dpath|"est_ent2.vw") order change key "[Est_Nr]" 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() ' if x = -1 return (-1) elseif x = 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() ' if bdb = -1 ' ' message "$keypress is:"&str($keypress) ' if $keypress = "F3" or $keypress = "F5" or $keypress = "F6" ' or $keypress = "F7" ' x = vkeybox(9,29,"1Abandonÿthisÿentry 1Enterÿtemporaryÿproduct","Escape to return") ' if x = -1 ' AbandonEntry() ' exit while ' end if ' while true ' if ptstr == "a" ' AbandonEntry() ' return (-1) ' elseif ptstr == "e" ' "prodselb.vw" loaded ' messbox(" Enter a Temporary Product Code? (y/n) ",1,0,1) ' if ptstr == "y" ' screen shortrestore psa ' origview2=apinfo(ap_filex) ' TempProductCode() ' vloadif(dpath|origview2) ' else ' AbandonEntry() ' return (-1) ' end if ' exit while ' end if ' end while ' else ' AbandonEntry() ' exit while ' end if ' else ' prodcode = ptstr ' ' end if