'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 $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 ' $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 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? ' messboxwait(" N.B. hard-coded for WAREHOUSE ",0,0,1) file unload all SelectBranch() $branch=upper(left($place,1)) 'message "$branch) is:"&str($branch) 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 x=LoadEstimate(0) if x=2 Background() continue while end if 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 fm #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 altering line items; will save as new estimate 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() ' repaint on ' repaint ' single-step on if x = -1 ' abandon continue while else return (2) ' exit while 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() 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 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 MakeReqns() ' find all items for i=1 to precords ReqnEntries() data goto record next end for ' step thru entering colours END FUNCTION 'MakeReqns() 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 EnterCommission() ' ' 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 = EnterNewCommission() ' 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 = "Commission" ' ' x = EnterNewCommission() ' if x = -1 ' return (-1) ' end if ' vunloadif("besp_chk.vw") ' exit function ' end if ' END FUNCTION ' EnterCommission() ' FUNCTION EnterNewCommission() ' local mess oldstrt deldate ' ordref = "" ' specterm = "" ' if upd_new = "NEW" ' purchorderdate = today ' else ' purchorderdate = date2([Date_Ordered]) ' orderby = [Ordered_By] ' prodcode = [Product_Code] ' delquot = [Delivery_Quoted] ' $comment = [Comments] ' ordref = [Order_Reference] ' end if ' ' while true ' while true ' ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ' ³ Enter comments re Purchase ³ ' ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ ' while true ' x = entryline(" Who is commission paid to? ",20,"","",21,5,72) ' if x = 0 ' suppname = ptstr ' exit while ' end if ' end while ' ' while true ' x = entryline(" Enter any comments ",35,"","",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(" Name of person entering Commission charge ","M72") ' screen print 21 5 fgp bgp y2 ' ' OrderedBy() ' ' y2 = format(" ","M72") ' screen print 21 5 fgp bgp y2 ' ' ' x = messline("’Commission of"¤cy(#ordlength)&"entered by"&orderby&"on"&purchorderdate&"? (y/n/Esc) ",1,0,0,21,5,72) ' x = messline("’Commission of"¤cy(#ordlength)&"entered by"&orderby&"on"&purchorderdate&"? (y/n/Esc) ",1,0,0,21,5,72) ' if x = 0 ' if ptstr == "y" ' repaint off ' exit while ' end if ' elseif x = -1 ' screen clear box 22 5 22 77 0 0 no-border ' return (-1) ' end if ' end while ' ' exit while ' end while ' desMRC = suppname ' $del = "W" ' END FUNCTION ' EnterNewCommission() 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()