'ENTREQNX - same as ENT_REQN but no ReturnToMenu 'continue at L1585 need to locate bespancl.idx after choosing supplier '25/09/00 - revised for temporary product code requests '06/12/01 - revised for temporary product code requests '28/06/02 - exclusions re Trade orders removed '14/07/05 - L2505 - reqns can now be entered without Order & Customer details '14/07/05 - L2540 - reqns can now be entered without Order & Customer details 'remove suppcode line 976 external fentrybox() chkdate() dpath vloadif() remove() base Background() external progress() vunloadif() sch scw shopmask exception() bgi bgs fgs external fgp bgp navrecs() userid scr increment() PrintReport() fgi $menu external bpopdb() chkstr() delstr() psa addidxrec() dsa makeidx() strtoary() external lpath bge popuplist() nr5 nr6 fdp bbd wraptext() arytostr() external delidxrec() getidxrecs() entryline() messline() messboxwait() external strcount() ipath colpopup() findcolpop() resref #maxleft #minleft external jobs[6] $enternow $actport shopname #conv_f2m UpdGdsOut() vatrate external cpath #margin_A #margin_B #margin_C #margin_D vkeybox() X_path external _SWIP_Crystal() Xreppath public ptstr jobnr ftrname custname deladdr1 deladdr2 deladdr3 deladdr4 public offtel hometel mobile ftginstr ftgcomm cr_status balancedue faxnr public ptval ptary[1] codes[1] #ordwidth prodcode desMRC $ccw refcode public plist[1,1] #refnr $screen global ver count Messbox() _shade() $showdel CheckFutureAppts() Title_C() global x y1 y2 ReturnToMenu() y deladdr custaddr custpost Authorise() pc global custpostcode custaddr1 custaddr2 custcity custcontact offax city global j CheckCustomer() MarginCheck() bline $update #bal_os #origlength global ReviewAddr() DeliveryAddr() CustomerAddr() S_details #quant_diff global ShowDetails() CheckOrder() CopyAddresses() WriteDetails() cust_title global ReferShop() #margin #netinv #totcost #percentmargin mess1 cat global r1 #count WriteHOLD() WritePASS() $fail #recnr CheckDelivered() global UpdApptRecs() $newstat $dayftr #cost_os #origcost #cost_diff varnr global $itemtype $rollnr prodMRC #prodrec #currliststck DeletePurchord() global #prevliststck #prec #newliststck Check_CCW() WriteDelete() #maxupd global AddReqn() y3 s_shwreq #record $Emess EnterFtg() AddVarnTrade() global $backing $mess1 $smlc $smlr $prev_C ConfirmUpdate_yn() $altref global $prev_R $effecdate $disc prodSUPP suppcode $newcolor a1 global $popcol EnterColour() CheckDupe() ShowBox() #old_bar #int_bar #new_bar global #ordlength #deflen $resvn maxwidth a2 a3 a4 a5 UpdateLength() global UpdatePurchord() custorderdate #unitcost #reqncost $auth global priceauthority $color i $colorstr EnterNewOrder() $altlen global currentorder ordref specterm purchorderdate $price_R $price_C delquot global EnterPurchord() $unsort SortColour() $newsort n $prodend #var global mess suppname $comment orderby consecnr UpdateEntries() spc global l1 l2 r2 c3 c1 c2 Entries() $mess2 ChooseWidth() MultipleCuts() global strtcol recs $popstr #nritems strtrow keyf keyb ChooseColour() global Title_A() ChooseLength() Confirm_yn() Title_B() upd_new global AmendReqns() UpdateReqn() jobidx #reqnrec $unit $delterms $priceterms global endcol OrderedBy() PrintWorkSheet() CheckJobNr() Warning() global DeleteReqn() #old_bal #new_bal $deladdr $del ProcessTrade() global #jobrec #reqnrecs S_save $instruct z f1 f2 f3 f4 #int_bal global reqs2alloc ques ReturnToMenu_B() #remainder #area ChkAllocations() global clearvar() x1 x2 CreateReqn() CheckBalance() CheckPostcode() global $refres #nrrequsns AllResvn2Requsn() $suffix ConfirmReservations() global #reqnlen $stock $ccwcode WriteRecord() AlterBalance() #balrem global $stat p1 p2 p3 p4 p5 p6 #length #totreqn #stk_BAR #stk_Bal global uistrcnt() udelstr() mr sym blen l rec drows k refresh() pg tr pad global b1 b2 pl lc sc PopLengths() RemoveReservation() #reslen $rescust global #resvnrecnr #precnr CreateMultipleRequsns() EnterCommission() global rcvd m4 $jobstr AddToArray() PopJobs() #override ChooseSupplier() global $o_ride UpdateTypeO() EnterOverride() $prevscn ConfirmMultiple_yn() global EnterNewOverride() EnterNewCommission() lastsuppcode lastsuppname ' Warning_C() global CommissionRcvd() BespStatus() StockStatus() F2M() $meas $uos global ReAllocate() EnterNewFtg() addn_lab $mess3 $text1 $text2 $text3 global EnterMultPurchOrder() MultPurchOrderDetails() $chk_alln Boxtext() global #dueout $increqn whseman CheckSupplier() ProcessChoice() cdel global ReplaceHardSpace() wreplstr() minord delchg ornote origview global ProcessRemnant() CreateStkBesp() checknr AllocateRollNr() global NewStockBespoke() locn $keypress TempProductCode() global EnterSupplier() newcode SelectType() $seltype global EnterDetails() check SelectBacking() $cat tempcode SelectUnit() global GetProductCode() UpdateProductCode() AbandonEntry() global TempCodeMultiCuts() ConfirmTempCodeMultiple_yn() global TempMultPurchOrderDetails() global EnterTempMultPurchOrder() $os $i_state MAIN single-step off f1help off Background() file unload all quiet on addn_lab = "L/700106" ' prompts for entry of desc of add'n labour $increqn = "N" whseman = "Richard" $i_state = "n" ' message "$menu) is:"&str($menu) redimension ptary[6] for i = 1 to 6 ptary[i] = jobs[i] end for x = arytostr(6) $jobstr = ptstr ' message "$jobstr) is:"&str($jobstr) p2 = "" ' p2 = title at top of choice popup ("LABEL") p3 = 1 ' p3 = printer to be used (1=HPIII_QC; 2=GEN_EPSN etc) p5 = 1 ' p5 = choose VIEW/PRINT 1=PRINT; 2=VIEW; 3=CHOOSE p6 = 1 ' p6 = nr of copies case base ' p4 = printer port to use (1,2 etc - network set to use 2=LASER; 3=LABEL) when "O" p4 = $actport when "W" p4 = $actport otherwise p4 = 1 end case vloadif(dpath|"cust_ord.vws") clear reqs2alloc vunloadif("cus_ent4.vw") vunloadif("cus_ent7.vw") keyf = 7 keyb = 0 $delterms = "2/3’days 7’days 7-10’days’ 14’days Other" $priceterms = "Cut’Price Roll’Price Other" prodcode = "" refcode = "" jobnr = @if(len(jobnr)=0,"",jobnr) x = remove("current.idx") ' create temp index for allocation x = makeidx("requsn","current.idx","0",1) x = remove("allocn.idx") ' create temp index for allocation x = makeidx("requsn","allocn.idx","0",1) x = CheckJobNr() if x = -1 ReturnToMenu() elseif x = -2 Background() ReturnToMenu_B() ' return direct to menu end if progress(15,1," Finding existing req'ns for"&jobnr|" ",0) vloadif(dpath|"cust_ord.vws") data find "[Job_Nr]" equal jobnr options "g" ' find correct JOB custorderdate = [Date_Of_Order] vunloadif("cust_ord.vws") while true x = AddReqn() ' 2=no reqns if x = 2 ReturnToMenu_B() ' return direct to menu end if x = AmendReqns() if x = -1 exit while end if end while error off #reqnrecs = records 'message "#reqnrecs is:"&str(#reqnrecs) if records>0 repaint off data goto record first data find "[Item_Type]" equal "C" options "" if cerror data goto record first data find "[Item_Type]" equal "S" options "" if cerror x = ChkAllocations() else messbox(" Create/review allocations? (y/n) ",1,1,1) if ptstr == "N" x = ChkAllocations() else screen save 1 1 sch scw $chk_alln execute "reqall_J.rf3" in-memory screen shortrestore $chk_alln x = ChkAllocations() end if repaint off end if else messbox(" Create/review allocations? (y/n) ",1,1,1) if ptstr == "N" x = ChkAllocations() else screen save 1 1 sch scw $chk_alln execute "reqall_J.rf3" in-memory screen shortrestore $chk_alln x = ChkAllocations() end if repaint off end if else ChkAllocations() end if ' $os= ReturnToMenu() END MAIN FUNCTION ConfirmReservations() ' in CUS_ENT4/current.idx local #resvnBAR #resvnBAL messq sr repaint off ' enter nr of reservation while true x = fentrybox(" Enter Reservation reference ",6,resref,"") if x = -1 return (-1) end if $refres = ptstr|"-00" vloadif(dpath|"chckresv.vw") order change key "[Reference_Nr]" ' search in [Reference_Nr] for resref data find "[Reference_Nr]" equal $refres options "" if cerror ' if none - then return messbox(" Reference not found - enter again ",0,0,1) continue while else $stat = [Status] if $stat = "D" messbox(" This Reservation has been deleted - enter again ",0,0,1) continue while end if end if $rescust = [Comment] L1 = len($rescust)-7 ' message "L1 is:"&str(L1) $rescust = right([Comment],L1) ' message "$rescust is:"&str($rescust) #reslen = [Length_Quantity] ' message "#reslen is:"&str(#reslen) $rollnr = [RollNr] prodcode = [Product_Code]' message "prodcode -L207- is:"&str(prodcode) prodMRC = [Product_MRC] desMRC = [Description_MRC] $itemtype = [Item_Type] #ordwidth = [Width] $backing = [R_Backing] #resvnrecnr= precord $ccwcode = [CCW_Code] 'message "$ccwcode is:"&str($ccwcode) #unitcost = [Unit_Cost] ' message "#unitcost is:"&str(#unitcost) ' message "235//$backing is:"&str($backing) messbox(" Reservation of"&fixed(#reslen,2)|"m for"&$rescust|"? (y/n) ",1,1,1) if ptstr == "y" exit while else continue while end if end while #stk_BAR = [BAR] ' find BAR & Balance #stk_Bal = [Balance] while true ' cycle thru to enter lengths x = fentrybox(" Nr of individual requisitions from this reservation ",2,"*2{[1234567890]}","") if x = -1 return (-1) end if #nrrequsns = value(ptstr) #balrem = #reslen #reqnlen = "" #totreqn = 0 for i = 1 to #nrrequsns $suffix = case i (1,"st")(2,"nd")(3,"rd") else "th" x = fentrybox(" Length of"&str(i)|$suffix&"requisition ",5,"*5{[1234567890.]}","") if x = -1 continue while end if #length = value(ptstr) if #length = 0 messbox(" Cannot enter ZERO length ",0,0,1) #balrem = #reslen #reqnlen = "" #totreqn = #length ' message "#length is:"&str(#length) continue while end if #balrem = #balrem - #length #totreqn = #totreqn + #length #reqnlen = #reqnlen&fixed(#length,2) end for messq = " Confirm list of requisitions correct? (y/n) " z=len(messq) 'message "z is:"&str(z) ' sr = len(messq)+19 sr = len(messq)+20 x = PopLengths(10,sr,21,#reqnlen,"",1,0) ' show list ' x = PopLengths(10,65,21,#reqnlen,"",1,0) ' show list screen shortrestore dsa $prevscn = psa ' confirm Y/N to list; N=re-enter messbox(" Confirm list of requisitions correct? (y/n) ",1,1,1) if ptstr == "y" screen shortrestore $prevscn exit while else screen shortrestore $prevscn #balrem = #reslen #reqnlen = "" #totreqn = #length continue while end if end while #new_bal = #stk_Bal - #totreqn ' message "#new_bal is:"&str(#new_bal) if #new_bal < #maxleft and #new_bal > #minleft ' check for "balance" problem if $menu == "boss" messline(" This will leave a balance between 0.6m and 5.0m on roll - continue? (y/n) ",1,0,1,21,6,72) if ptstr == "y" ' add back resv'n to BAR - WARN!! vloadif(dpath|"stk_carp.vws") order change key "[RollNr]" data find "[RollNr]" equal $rollnr options "" if cerror ' if none - then return x = messbox(" Roll Nr not found - cannot lock ",0,0,1) end if #resvnBAL = [Balance] ' message "total req'ns are:"&str(#totreqn) #resvnBAL = #resvnBAL - #totreqn ' message "#resvnBAL is:"&str(#resvnBAL) #resvnBAR = [BAR] #resvnBAR = #resvnBAR + value(#reslen) - #totreqn ' message "#resvnBAR is:"&str(#resvnBAR) lock-record ' lock carpet record [BAR] = #resvnBAR [Balance] = #resvnBAL write-record ' unlock carpet record RemoveReservation() ' AllResvn2Requsn() ' L.683 vloadif(dpath|"stk_carp.vws") elseif ptstr == "n" screen shortrestore dsa return (1) end if else messboxwait(" Must be allocated by DG, do NOT pass to Head Office ",0,0,1) screen shortrestore dsa return (1) end if elseif #totreqn > #stk_Bal messboxwait(" Insufficient on roll, use other rolls as well ",0,0,1) messboxwait(" Your reservation will now be released and requisitions made ",0,0,1) ' lock all stk_carp records with similar idx vloadif(dpath|"stk_carp.vws") order change key "[RollNr]" data find "[RollNr]" equal $rollnr options "" if cerror ' if none - then return x = messbox(" Roll Nr not found - cannot lock ",0,0,1) end if #resvnBAL = [Balance] ' message "total req'ns are:"&str(#totreqn) #resvnBAL = #resvnBAL - #totreqn ' message "#resvnBAL is:"&str(#resvnBAL) #resvnBAR = [BAR] #resvnBAR = #resvnBAR + value(#reslen) - #totreqn ' message "#resvnBAR is:"&str(#resvnBAR) lock-record ' lock carpet record [BAR] = #resvnBAR [Balance] = #resvnBAL RemoveReservation() ' CreateMultipleRequsns() 'message "create new requ'ns ####" execute "reqall_J.rf3" in-memory ' allocate all reqns else ' NO problem messboxwait(" Your reservation will now be released and requisitions made ",0,0,1) vloadif(dpath|"stk_carp.vws") order change key "[RollNr]" data find "[RollNr]" equal $rollnr options "" if cerror ' if none - then return x = messbox(" Roll Nr not found - cannot lock ",0,0,1) end if #resvnBAL = [Balance] ' message "total req'ns are:"&str(#totreqn) #resvnBAL = #resvnBAL - #totreqn ' message "#resvnBAL is:"&str(#resvnBAL) #resvnBAR = [BAR] #resvnBAR = #resvnBAR + value(#reslen) - #totreqn ' message "#resvnBAR is:"&str(#resvnBAR) lock-record ' lock carpet record [BAR] = #resvnBAR [Balance] = #resvnBAL write-record ' unlock carpet record RemoveReservation() ' AllResvn2Requsn() ' L.683 vloadif(dpath|"stk_carp.vws") end if END FUNCTION 'ConfirmReservations() FUNCTION EnterFtg() vloadif(dpath|"ftg_ords.vw") order change key "[Order_Nr]" data find "[Order_Nr]" equal refcode options "" if cerror x = EnterNewFtg() if x = -1 return (-1) end if vunloadif("ftg_ords.vw") return (0) else currentorder = precord orderby = [Ordered_By] purchorderdate = [Date_Ordered] prodcode = [Product_Code] delquot = [Delivery_Quoted] $comment = [Comments] x = EnterNewFtg() if x = -1 return (-1) end if vunloadif("besp_chk.vw") return (0) end if END FUNCTION ' EnterFtg() FUNCTION EnterNewFtg() local mess oldstrt ordref = "" if upd_new = "NEW" orderby = userid purchorderdate = today else purchorderdate = date2([Date_Ordered]) orderby = [Ordered_By] $comment = [Comments] end if vloadif(dpath|"ftg_ordr.vws") ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ create/update FTG_ORDR 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 [Date_Ordered] = today [Ordered_By] = orderby [Product_Code] = prodcode [Order_Nr] = refcode [Last_Update] = today [Updated_By] = userid [Carpet_Color] = desMRC [Order_Cost] = #ordlength [Order_Status] = "P" write-record END FUNCTION ' EnterNewFtg() FUNCTION CreateMultipleRequsns() #newliststck = "1" ' $itemtype = "C" 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 order change index "current.idx" x = strtoary(#reqnlen) ' for i = 1 to #nrrequsns error off #refnr = filemax([#refnr]) ' if cerror #refnr = 0 end if refcode = jobnr|"-"|str(right("00"|str(#refnr+1),2)) ' message "refcode is:"&str(refcode) $stat = "I" #ordlength = ptary[i] #reqncost = value(#ordlength)*value(#ordwidth)*value(#unitcost) $rollnr = "00000/00" WriteRecord() #ordlength = 0 end for return (0) END FUNCTION 'CreateMultipleRequsns() FUNCTION AllResvn2Requsn() ' lock STK_CARP record; delete/void reservation #newliststck = "1" ' $itemtype = "C" 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 order change index "current.idx" x = strtoary(#reqnlen) ' message "#nrrequsns is:"&str(#nrrequsns) for i = 1 to #nrrequsns error off #refnr = filemax([#refnr]) ' if cerror #refnr = 0 ' end if refcode = jobnr|"-"|str(right("00"|str(#refnr+1),2))' #ordlength = ptary[i] #reqncost = value(#ordlength)*value(#ordwidth)*value(#unitcost) $stat = "A" WriteRecord() #ordlength = 0 end for return (0) END FUNCTION ' AllResvn2Requsn() FUNCTION WriteRecord() ' 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 'WriteRecord() 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 RemoveReservation() vloadif(dpath|"delresvn.vw") data goto record record-number #resvnrecnr lock-record [Comment] = "Resv'n removed - req'ns made" [Date_Status_Changed] = today [Created/Changed_By] = userid [Status] = "D" [RollNr] = "NA" [Reserved] = "D" [RollReserve] = "" write-record data delete record END FUNCTION 'RemoveReservation() 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 AddReqn() local z #deflen $wrongprod f1 f2 f3 nr_reqns nr_index ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Show current requsn's ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ upd_new = "NEW" vloadif(dpath|"cus_ent4.vw") order change key "[Job_Nr]" data query execute "job_reqn.dfq" index "current.idx" ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' [Job_Nr] = jobnr ' and ' not(deleted) ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if cerror makeidx("requsn","current.idx","0",1) order change index "current.idx" end error off data goto record last Title_A() ' show list of F numbers and await selection of Itemtype repaint off ptval=0 while true tempcode="N" clear prodcode lastsuppcode=suppcode ' clear suppcode clear prodMRC clear #unitcost clear $seltype clear $itemtype clear #ordwidth clear $backing clear desMRC clear $unit clear $keypress prodcode = "" x = inchar 'message "x is:"&str(x) if x = 316 ' F2 - Stock Carpet - IT = "A" tempcode="N" clear prodMRC clear #unitcost clear $seltype clear $itemtype clear #ordwidth clear $backing clear desMRC clear $unit $prodend ="A" ProcessChoice("stckcarp.idx") elseif x = 315 ' F1 - Remnant tempcode="N" clear suppcode clear prodMRC clear #unitcost clear $seltype clear $itemtype clear #ordwidth clear $backing clear desMRC clear $unit ' clear $keypress $prodend = "B" while true vloadif(dpath|"cus_ent4.vw") error off #refnr = filemax([#refnr]) 'message "#refnr) is:"&str(#refnr) if cerror #refnr = 0 end if refcode = jobnr|"-"|str(right("00"|str(#refnr+1),2))' clearvar() #prodrec = record prodcode = ptstr screen shortrestore dsa ProcessRemnant() vloadif(dpath|"cus_ent4.vw") order change index "current.idx" data goto record last Title_A() exit while end while elseif x = 317 ' F3 - Bespoke Carpet - IT = "B" tempcode="N" ' clear prodcode clear suppcode clear prodMRC clear #unitcost clear $seltype clear $itemtype clear #ordwidth clear $backing clear desMRC clear $unit ' clear $keypress $prodend = "B" $cat = "B" $keypress = "F3" ProcessChoice("bespcarp.idx") elseif x = 318 ' F4 - Stock Ancl - IT = "A" tempcode="N" ' clear prodcode clear suppcode clear prodMRC clear #unitcost clear $seltype clear $itemtype clear #ordwidth clear $backing clear desMRC clear $unit $prodend = "A" ProcessChoice("stckancl.idx") elseif x = 319 ' F5 - Bespoke Ancl - IT = "J" tempcode="N" ' clear prodcode ' clear suppcode clear prodMRC clear #unitcost clear $seltype clear $itemtype clear #ordwidth clear $backing clear desMRC clear $unit ' clear $keypress $prodend = "B" $cat = "J" $keypress = "F5" ProcessChoice("bespancl.idx") elseif x = 320 ' F6 - Vinyl - IT = "V or W" tempcode="N" ' clear prodcode clear suppcode clear prodMRC clear #unitcost clear $seltype clear $itemtype clear #ordwidth clear $backing clear desMRC clear $unit ' clear $keypress $prodend = "B" $cat = "W" $keypress = "F6" ProcessChoice("vinyl.idx") elseif x = 321 ' F7 - Tiles - IT = "S or T" $prodend = "B" $cat = "T" ' $keypress = "F7" ' ProcessChoice("vinyl.idx") while true tempcode="N" ' clear prodcode clear suppcode clear prodMRC clear #unitcost clear $seltype clear $itemtype clear #ordwidth clear $backing clear desMRC clear $unit ' clear $keypress vloadif(dpath|"cus_ent4.vw") error off #refnr = filemax([#refnr]) 'message "#refnr) is:"&str(#refnr) if cerror #refnr = 0 end if refcode = jobnr|"-"|str(right("00"|str(#refnr+1),2))' clearvar() vloadif(dpath|"prodsel"|$prodend|".vw") x = popuplist(20,59,25,"Stock Bespoke","",1,0) if ptstr = "Stock" order change index ipath|"stk_tile.idx" ' bpop must show MRC ?????????????? else $keypress = "F7" order change index ipath|"bsp_tile.idx" ' bpop must show MRC ?????????????? end if if prodcode = "" y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) else data goto record record-number #prodrec y2 = format(" Scroll or press {F3} to search - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"i","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) end if if x = -1 repaint off vloadif(dpath|"cus_ent4.vw") order change index "current.idx" y2 = format("Select requisition type or {F10} to exit","M72") screen print 21 5 fgp bbd y2 vloadif(dpath|"prodsel"|$prodend|".vw") exit while end if #prodrec = record prodcode = ptstr if [Note]="Y" CheckSupplier() end if $uos = [Unit_Of_Sale] $backing = [Backing] screen shortrestore dsa ' message "892//$backing is:"&str($backing) x = Entries() if x = -1 screen clear box 5 5 22 77 0 0 no-border screen shortrestore s_shwreq repaint off Title_C() continue while elseif x = 0 vloadif(dpath|"cus_ent4.vw") order change index "current.idx" data goto record last Title_A() vloadif(dpath|"prodsel"|$prodend|".vw") continue while end if end while elseif x = 322 ' F8 - Fitting - IT = "F" ' if left(jobnr,1)="T" ' messboxwait(" Cannot enter Fitting req'ns on Trade Orders ",0,0,1) ' continue while ' end if $prodend = "A" ProcessChoice("labour.idx") elseif x = 323 ' F9 - reservations x = ConfirmReservations() if x = -1 continue while else screen clear box 1 1 sch scw 0 0 no-border vloadif(dpath|"cus_ent4.vw") order change index "current.idx" data goto record last Title_A() continue while end if elseif x = 324 ' F10 - order change physical vloadif(dpath|"cus_ent4.vw") if records > 0 if $increqn ="Y" x = CheckFutureAppts() end if screen clear box 22 1 sch scw 0 0 no-border return (0) else ' no reqns entered OR active return (2) end if screen clear box 22 1 sch scw 0 0 no-border return (0) elseif x = 763 ' {Esc} return (2) end if end while data goto record last return (0) END FUNCTION ' AddReqn() FUNCTION Entries() 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 Title_A() y1 = format(left(jobnr&"-"&custname&"@"&deladdr1,72),"M72") y3 = format(" Description Colour Length Width Bckg","L72") repaint on repaint screen print 5 5 15 12 y1 screen print 6 5 fdp bbd y3 y2 = format("Select requisition type or {F10} to exit","M72") screen print 21 5 fgp bbd y2 screen save 5 5 21 77 s_shwreq repaint off Title_C() END FUNCTION 'Title_A() FUNCTION Title_C() f1 = format(" F2 ³ F3 ³ F4 ³ F5 ³ F6 ³ F7 ³ F8 ","L80") f2 = format(" Stock ³ Bespoke ³ Stock ³ Bespoke ³ Vinyls ³ Tiles ³ Labour ","L80") f3 = format(" Carpet ³ Carpet ³ Ancll'y ³ Ancll'y ³ ³ ³ ","L80") f4 = format("F1 - Remnants / F9 - Convert Reservations","M72") ' f4 = format("F9 - Convert Reservations","M72") screen print 22 1 keyf keyb f1 screen print 23 1 keyf keyb f2 screen print 24 1 keyf keyb f3 screen print 25 5 15 12 f4 END FUNCTION 'Title_C() FUNCTION ChooseWidth() while true ' start WIDTH section if $itemtype = "A" #ordwidth = value([Widths_Available]) exit while elseif $itemtype = "O" #ordwidth = value([Widths_Available]) exit while elseif $itemtype = "F" #ordwidth = value([Widths_Available]) exit while elseif $itemtype = "S" #ordwidth = value([Widths_Available]) exit while elseif $itemtype = "T" #ordwidth = value([Widths_Available]) exit while else ' ÉĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶ» ' ŗ Enter & check width ŗ ' ČĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶĶ¼ while true if [Widths_Available] ! "V" maxwidth = right([Widths_Available],5) x = entryline(" This carpet is available in any width upto"&maxwidth|"m",5,"","",21,5,72) if x = 0 #ordwidth = value(ptstr) if #ordwidth > value(maxwidth) messline(" Width cannot be greater than"&maxwidth|"m",0,0,1,21,5,72) continue while elseif #ordwidth = "" continue while end if exit while end if end if ' 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 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 UpdateTypeO() ' get variables from PRODSELA.VW $itemtype = [Item_Type] prodMRC = [Product_MRC] while true ' start selection of widths colours etc x = ConfirmUpdate_yn() if x = -1 ' {Esc} pressed return (-1) elseif x = 1 ' not accepted continue while else return (0) end if end while END FUNCTION ' UpdateTypeO() FUNCTION UpdateEntries() ' get variables from PRODSELA.VW $itemtype = [Item_Type] 'message "$itemtype) is:"&str($itemtype) prodMRC = [Product_MRC] if $itemtype = "B" or $itemtype = "C" $mess1 = "("|$backing|")" else $backing = "N/A" $mess1 = "" end if $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) 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 $altlen = "Y" x = UpdateLength() if x = -1 return (-1) end if end if x = ConfirmUpdate_yn() if x = -1 ' {Esc} pressed return (-1) elseif x = 1 ' not accepted continue while else return (0) end if end while END FUNCTION ' UpdateEntries() FUNCTION EnterColour() local $fldlen $usedlen $fldlen = dbfldinfo("[Colours]",2) $usedlen = str(len([Colours])) while true x = entryline(" Enter Colour Description or {Esc} to abandon ",20,"","",21,5,72) if x = 0 if ptstr = "" continue while end if $color = proper(ptstr) if len(ptstr) > (value($fldlen) - value($usedlen)) return (1) ' !!!!!!!!!!!!!!!! TEST ONLY end if x = messline(" Confirm new Colour -"&$color|"? (y/n)",1,1,1,21,5,72) if x = 0 if ptstr == "n" continue while else x = CheckDupe($color) ' 0 OK if x = 0 ' -1 maybe - show popup exit while ' -2 DUPLICATE elseif x = -1 scr = scr - 2 messline($color&"- duplicated?",0,0,1,21,5,72) y2 = format(" "|chr(24)&chr(25)&"to find - {Enter} to select colour - {Esc} if not listed ","M72") screen print 21 5 fgp bgp y2 screen shortrestore dsa x = popuplist(8,57,18,[Colours],"",1,0) if x = -1 ' {Esc} pressed x = messline(" Confirm "|$color&"(y/n)",1,1,1,21,5,72) if ptstr == "y" scr = scr + 2 exit while else continue while end if else ' Alternative selected $newcolor = ptstr scr = scr + 2 exit while end if elseif x = -2 continue while end if end if end if elseif x = -1 return (-1) end if end while y = strtoary($color) $newcolor = "" for i = 1 to ptval if i = 1 $newcolor = ptary[i] ' NB - space is Alt-255 else $newcolor = $newcolor|"’"|ptary[i] ' NB - space is Alt-255 end if end for $unsort = [Colours]&trim($newcolor) repaint off SortColour() vloadif(dpath|"prodsel"|$prodend|".vw") lock-record [Colours] = $newsort write-record return (0) END FUNCTION ' EnterColour() FUNCTION SortColour() vloadif("temp_skl.vws") if precords <> 0 data query execute "delete" vunloadif("temp_skl.vws") data utilities purge "temp_skl" end if vloadif(dpath|"prodsel"|$prodend|".vw") x = strcount($unsort) ' message "x is:"&str(x) n = value(ptval) repaint off if value(n) = 0 return ($unsort) end if x = strtoary($unsort) ' message "x is:"&str(x) vloadif("temp_SKL.vws") for x = 1 to n data enter lock [Colour] = ptary[x] write-record end for if n > 1 order sort now dictionary "new" fields "[Colour]" ascending data goto record first end if $newsort = "" for x = 1 to n $newsort = $newsort&[Colour] data goto record next end for ' if precords = 1 data delete record else data query execute "delete" end if vunloadif("temp_skl.vws") data utilities purge "temp_skl" return $newsort END FUNCTION ' SortColour() FUNCTION CheckDupe($color) $colorstr = [Colours] x = chkstr($color,$colorstr) 'message "x) is:"&str(x) if x = -1 ' $color NOT found in $colorstr strtoary($color) for i = 1 to ptval y = ptary[i] if match($colorstr,y) <> 0 ' one word exists in $colorstr return (-1) ' MAYBE ! else return (0) ' NOT a duplicate end if end for elseif x = 0 ' $color found in $colorstr screen shortrestore psa scr = scr - 2 messline($color&"is a duplicate!",0,0,1,21,5,72) scr = scr + 2 return (-2) end if END FUNCTION 'CheckDupe() FUNCTION ShowBox() local x x1 x2 x3 x4 x5 x6 load lpath|"wraptext.rf3" in-memory screen clear box 1 1 sch scw 0 0 no-border repaint off x1 = " Insufficient space in [Colours] field to add: " x2 = "’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’" x3 = $color x4 = "’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’" x5 = " Report Product Code"&prodcode&"to Supervisor press {Esc} to continue" x = x1&x2&x3&x4&x5 wraptext(8,15,15,65,fgp,bge,x,"M",1,0,1) unload "wraptext.rf3" END FUNCTION ' ShowBox() FUNCTION EnterPurchord() ' 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 UpdatePurchord() vloadif(dpath|"besp_chk.vw") order change key "[Order_Nr]" data find "[Order_Nr]" equal refcode options "" if cerror return (-1) else currentorder = precord orderby = [Ordered_By] purchorderdate = [Date_Ordered] delquot = [Delivery_Quoted] $comment = [Comments] specterm = [Special_Terms] upd_new = "UPD" x = EnterNewOrder() if x = -1 return (-1) end if vunloadif("besp_chk.vw") exit function end if END FUNCTION ' UpdatePurchord() FUNCTION ConfirmUpdate_yn() 'Obtain reference & show confirmation box while true ' ?? $unit = [Unit_Desc] #area = #ordlength*#ordwidth $uos = [Unit_Of_Sale] if $uos = "U3" if $backing = "COMM" $mess3 = " Commission of œ"|fixed(#ordlength,2)|"? (y/n/Esc) " else if $itemtype = "F" $mess3 = prodMRC&"for œ"|fixed(#ordlength,2)|"? (y/n/Esc) " else $mess3 = prodMRC&"of œ"|fixed(#ordlength,2)|" from"&suppname|"? (y/n/Esc) " end if end if else $text1 = " Confirm "|fixed(#ordlength,2)&$unit&"(total area "|fixed(#area,2)|"sq m)? (y/n/Esc) " $text2 = " Confirm quantity "|fixed(#ordlength,2)|"? (y/n/Esc) " $text3 = " Confirm "|fixed(#ordlength,2)|"? (y/n/Esc) " $mess3 = case $itemtype ("B",$text1)("C",$text1)("V",$text1)("W",$text1)\ ("A",$text2)("F",$text3)("J",$text2)("S",$text2)("T",$text2)("O",$text3) else $text1 end if x = messline($mess3,1,1,0,21,5,72) if x = 0 if ptstr == "n" screen clear box 22 5 22 77 0 0 no-border return (1) elseif ptstr == "y" screen clear box 22 5 22 77 0 0 no-border repaint off exit while end if elseif x = -1 screen clear box 22 5 22 77 0 0 no-border return (-1) end if end while repaint off ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Create Purchase order for bespoke & check prices ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if $itemtype = "B" x = UpdatePurchord() ' returns #unitcost if x = -1 return (-1) end if elseif $itemtype = "J" x = UpdatePurchord() ' returns #unitcost if x = -1 return (-1) end if elseif $itemtype = "T" x = UpdatePurchord() ' returns #unitcost if x = -1 return (-1) end if elseif $itemtype = "W" x = UpdatePurchord() ' returns #unitcost if x = -1 return (-1) end if elseif $itemtype = "O" #unitcost = 1 if $backing = "OVER" x = EnterOverride() ' if x = -1 return (-1) end if 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 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) vloadif(dpath|"cus_ent7.vw") ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Assign revised figures to REQUSN & PURCHORD ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ #quant_diff = #ordlength - #origlength #cost_diff = #reqncost - #origcost #bal_os = #bal_os + #quant_diff #cost_os = [Cost_OS] + #cost_diff if #ordlength > #origlength x = CheckFutureAppts() end if ' message "1571-prodcode is:"&str(prodcode) while true lock-record ' refcode/itemtype/status - NOT changed [Product_Code] = prodcode [Product_MRC] = prodMRC [Description_MRC] = desMRC [Length_Quantity] = #ordlength [Quant_OS] = #bal_os [Cost] = fixed(#reqncost,2) [Cost_OS] = #cost_os [Comment] = $auth [Width] = #ordwidth [Created/Changed_By] = userid [CCW_Code] = $ccwcode [RollNr] = $rollnr [R_Backing] = $backing [prodrec] = #prodrec write-record #prec = str(precord) UpdGdsOut($rollnr,refcode) vloadif(dpath|"requsn.vws") order change physical vloadif(dpath|"cus_ent4.vw") exit while end while END FUNCTION ' ConfirmUpdate_yn() FUNCTION Confirm_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 ' repaint on ' repaint ' single-step on 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 Title_B() local f1 f2 f3 y1 y2 y3 y1 = format(" R E V I E W S C R E E N ","M72") y2 = format(left(jobnr&"-"&custname&"@"&deladdr1,72),"M72") y3 = format(" Description Colour Length Width Bckg","L72") repaint on repaint screen print 4 5 15 12 y1 screen print 5 5 15 12 y2 screen print 6 5 fdp bbd y3 y2 = format("{R}eallocate - {U}pdate reqn - {D}elete reqn - {F10} finishes","M72") screen print 21 5 fgp bbd y2 END FUNCTION 'Title_B() FUNCTION clearvar() ' clear suppcode clear #ordlength clear ordref clear orderby clear purchorderdate clear delquot clear $comment clear specterm clear prodMRC clear $itemtype clear #reqncost clear $auth clear #ordwidth clear $ccwcode clear $rollnr clear $backing $o_ride = 0 END FUNCTION ' clearvar() FUNCTION ReturnToMenu_B() screen clear box 1 1 sch scw 0 0 no-border repaint off error off while true window close if cerror exit while end if end while file unload all 'message "reqs2alloc is:"&str(reqs2alloc) fopen dpath|userid|".jnr" as 1 fwrite 1 from $jobstr fclose 1 if reqs2alloc = "Y" execute "reqall_J.rf3" in-memory screen clear box 1 1 sch scw 0 0 no-border repaint off error off while true window close if cerror exit while end if end while screen clear box 1 1 sch scw 0 0 no-border file unload all fopen dpath|userid|".jnr" as 1 fwrite 1 from $jobstr fclose 1 clear jobnr ' transfer "pm_menu.psl" in-memory else screen clear box 1 1 sch scw 0 0 no-border file unload all fopen dpath|userid|".jnr" as 1 fwrite 1 from $jobstr fclose 1 clear jobnr ' transfer "pm_menu.psl" in-memory end if END FUNCTION ' ReturnToMenu_B() 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 PrintWorkSheet() repaint off vloadif(dpath|"ftrwks_s.vw") order change key "[Job_Nr]" data find "[Job_Nr]" equal jobnr options "gw" if cerror ' if none - then return messbox(" Job not found - no worksheet printed ",0,0,1) return (-1) else ' get variables ftrname = [Nickname] custname = [CustOrd_Name] deladdr1 = [Delivery_Address_1] deladdr2 = [Delivery_Address_2] deladdr3 = [Del_City] deladdr4 = [Del_Postcode] offtel = [Office_Tel] hometel = [Home_Tel] ftginstr = [Instructions] ftgcomm = [Fitting_Comment] cr_status = [Credit_Status] mobile = [Mobile/Other_Nr] balancedue= [Balance_Due] ' find req'ns (not deleted) for jobnr vloadif(dpath|"ftrwks_X.vw") ' vloadif(dpath|"lststk_a.vw") order change key "[Job_Nr]" data query execute "job_reqn.dfq" index "jobreqn1.idx" ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' [Job_Nr] = jobnr ' and ' not(deleted) ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ ' sort by LstOrder order sort execute dictionary "lst_stck" index "lst_stck" remove(X_path|"X_ftrwks.*") data query execute "not_del.dfq" Smart4 X_path|"X_ftrwks" fields "[Fitting_Date|Width]" vunloadif("X_ftrwks.vws") ' ClearHardSpaces() _SWIP_Crystal(Xreppath|"X_ftrwks","P",0,1,"") vloadif(dpath|"ftrwks_X.vw") ' PrintReport("ftrwks_s.dfr","Job Worksheet",p3,p4,p5,p6) ' return (0) end if END FUNCTION 'PrintWorkSheet() ' vunloadif("X_inv_a.vws") ' ClearHardSpaces() ' _SWIP_Crystal(Xreppath|"$inv_1","P",0,1,"") ' _SWIP_Crystal(Xreppath|"$inv_1","EP",0,1,invpath|$nextinvnr|".pdf") FUNCTION Warning() local cl1 cl2 r1 = 8 r2 = r1+8 c1 = 7 c2 = c1+66 cl1 = 15 cl2 = 12 screen clear box 18 7 18 73 15 12 no-border screen save r1 c1 r2 c2 S_save screen clear box r1 c1 r2 c2 cl1 cl2 y1 = format("This order will be passed to Head Office for authorization","M65") y2 = format("and you CANNOT add or re-allocate requisitions after that.","M65") y3 = format(" Without authorization, it cannot be prepared for fitting.","M65") screen print r1+2 c1+1 cl1 cl2 y1 screen print r1+4 c1+1 cl1 cl2 y2 screen print r1+6 c1+1 cl1 cl2 y3 END FUNCTION 'Warning() FUNCTION CheckBalance() ' in vloadif(dpath|"cus_ent7.vw") vloadif(dpath|"stk_carp.vws") order change key "[RollNr]" data find "[RollNr]" equal $rollnr options "" if cerror messline(" Stock roll not found ",0,1,1,21,5,72) screen clear box 22 1 22 scw 0 0 no-border vloadif(dpath|"cus_ent7.vw") return (1) end if #record = precord #old_bal = [Balance] #old_bar = [BAR] vloadif(dpath|"cus_ent7.vw") #int_bal = #old_bal + #ordlength #int_bar = #old_bar + #ordlength while true 'message "#ordlength is:"&str(#ordlength) messline(" Are you re-allocating from the same roll? (y/n) ",1,1,1,21,5,72) if ptstr == "y" while true $mess2 = " Enter Length required (5cm steps) " x = entryline(prodcode&"-"&mid($mess2,3,33),6,nr6,#ordlength,21,5,72) if x = 0 if value(ptstr) = 0 continue while elseif $itemtype = "S" #ordlength = value(ptstr) exit while elseif round(mod(value(ptstr)*100,5),0)=0 or round(mod(value(ptstr)*100,5),0)=5 #ordlength = value(ptstr) screen clear box 22 1 22 scw 0 0 no-border exit while else ptstr = value(ptstr) x = round(ptstr*20,0)/20 #ordlength = fixed(@if(x #minleft messline(" Cannot leave balance between 0.6m and 5.0m on roll - re-enter? (y/n) ",1,0,1,21,5,72) if ptstr == "y" screen clear box 22 1 22 scw 0 0 no-border continue while else screen clear box 22 1 22 scw 0 0 no-border vunloadif("stk_carp.vws") return (1) end if else vloadif(dpath|"stk_carp.vws") data goto record record-number #record lock-record [Balance] = #new_bal [BAR] = #new_bar write-record vunloadif("stk_carp.vws") vloadif(dpath|"cus_ent7.vw") lock-record [Length_Quantity] = #ordlength write-record return (1) end if elseif ptstr == "n" ' NOT re-allocating from same roll #new_bal = #old_bal + #ordlength 'message "#old_bal is:"&str(#old_bal) #new_bar = #old_bar + #ordlength 'message "#old_bal is:"&str(#old_bal) if #new_bal < #maxleft and #new_bal > #minleft messline(" Cannot update (balance on roll between 0.6m and 5.0m) ",0,0,1,21,5,72) screen clear box 22 1 22 scw 0 0 no-border vunloadif("stk_carp.vws") return (1) else vloadif(dpath|"stk_carp.vws") data goto record record-number #record lock-record [Balance] = #new_bal [BAR] = #new_bar write-record vunloadif("stk_carp.vws") vloadif(dpath|"cus_ent7.vw") $rollnr = "00000/00" exit while end if end if end while END FUNCTION 'CheckBalance() FUNCTION AlterBalance() ' in vloadif(dpath|"cus_ent7.vw") repaint off vloadif(dpath|"stk_carp.vws") order change key "[RollNr]" data find "[RollNr]" equal $rollnr options "" if cerror messline(" Stock roll not found ",0,1,1,21,5,72) screen clear box 22 1 22 scw 0 0 no-border vunloadif("stk_carp.vws") vloadif(dpath|"cus_ent7.vw") return (1) end if #record = precord #old_bal = [Balance] #old_bar = [BAR] vloadif(dpath|"cus_ent7.vw") #int_bal = #old_bal + #ordlength #int_bar = #old_bar + #ordlength while true 'message "#ordlength is:"&str(#ordlength) #new_bal = #old_bal + #ordlength 'message "#old_bal is:"&str(#old_bal) #new_bar = #old_bar + #ordlength 'message "#old_bal is:"&str(#old_bal) if $itemtype="C" if #new_bal < #maxleft and #new_bal > #minleft messline(" Cannot delete - will leave a balance of"&fixed(#new_bal,2)|"m ",0,0,1,21,5,72) return (1) end if end if vloadif(dpath|"stk_carp.vws") data goto record record-number #record lock-record [Balance] = #new_bal [BAR] = #new_bar write-record vunloadif("stk_carp.vws") vloadif(dpath|"cus_ent7.vw") $rollnr = "00000/00" return (0) end while END FUNCTION 'AlterBalance() function refresh(z,r1,c1,r2,c2,pad,b1,b2) local x t screen clear box r1 c1 r2+1 c2+pad b1 b2 drows = 0 for x=0 to pl-1 t = rec-z+x+1 if t > recs exit for else if t > 0 screen print x+1+r1 lc b1 b2 plist[t,2] drows=drows+1 if plist[t,1]=1 screen print x+1+r1 sc b1 b2 sym end if end if end if end for end function 'refresh() function uistrcnt(sl) local i s lo hi c s=20 while exact(group(sl,s),NULL)=FALSE s=s+20 end while hi = s lo = 1 while lo <= hi i = int((lo+hi)/2) c = group(sl,i) if c = NULL hi = i-1 else lo = i+1 end if end while while (exact(group(sl,i),NULL)=TRUE and i>0) i=i-1 end while return (i) end function 'uistrcnt() function udelstr(s,sl) local t i n f f=0 i=0 n=NULL ptstr = NULL while TRUE i=i+1 t = group(sl,i) if exact(t,NULL)=TRUE exit while elseif t = s f=1 else n=n&t end if end while if f = 1 ptstr = trim(n) return (0) end if ptstr = sl return (-1) end function 'udelstr() FUNCTION PopLengths(r1,c1,br,list,msg,num,mnu) local t hml hm cnum mscn pad padc ret c dc lc sc pl pc fgc bgc fgc = 14 bgc = 1 if exact(trim(list),NULL)=FALSE recs = uistrcnt(list) if recs = 0 return (-3) end if else return (-2) end if redimension plist[recs,3] smartpeek $_l1 hml if br-r1<1 return (-4) elseif br+1 > scrheight mr=scrheight-1 msg = "" else mr=br end if if br >= hml mnu = 0 end if screen save hml 1 hml scrwidth mscn if recs > scrheight if mnu = 1 screen clear box hml 1 hml scrwidth 0 0 no-border screen print hml 1 bgi bgs "Building list..." end if end if ptstr=NULL if mnu = 1 hm = case num (0,"Enter = select/unselect F10 = done Esc = exit") \ (1,"Enter = select Esc = exit (select: 1 item)") \ else "Enter = select/unselect F10 = done Esc = exit " & \ " (select up to:" & str(num) & "items)" else hm = NULL end if sym = spsymmap(28) cnum=0 blen=0 l=blen for c=1 to recs plist[c,2]=group(list,c) l=len(plist[c,2]) plist[c,1]=0 if l>blen blen=l end if end for c2=c1+blen+2 r2=r1+recs if r2>mr r2=mr end if dc=(c2-c1) lc=c1+1 pad = case num (1,1) else 2 sc=c1+pad-1 pl=(r2-r1) padc = repeat(chr(32),pad) for i = 1 to recs pc = 1 plist[i,2]=padc|format(plist[i,2],"r",dc-1) plist[i,3] = i if i = pl pc=pc+1 end if end for if recs > scrheight screen shortrestore mscn end if screen save r1 c1 r2+2 c2+pad psa screen clear box r1 c1 r2+1 c2+pad fgc bgc screen print r1 c1+1 fgc bgc "’Cuts’" pc=1 for c=1 to pl screen print c+r1 lc fgc bgc plist[c,2] end for if msg > null screen print r2+2 c1 fgi bgi str(format(left(msg,dc+pad+1),"M"|str(dc+pad+1))) end if if mnu = 1 screen clear box hml 1 hml scrwidth fgs bgs no-border screen print hml 1 fgs bgs (format(hm,"L"|str(scrwidth))) end if c=1 rec=1 ' screen print r1+c lc fgi bgi plist[rec,2] drows = pl screen save r1 c1 r2+2 c2+1+pad dsa screen shortrestore mscn screen shortrestore psa clear c k dc lc sc recs c2 r2 l blen pl mr pc sym pg i rec tr drows redimension plist[1,3] if trim(ret) = NULL ptstr = NULL return (-1) else ptstr = trim(ret) return (0) end if END FUNCTION 'PopLengths() FUNCTION DeletePurchord() ' message "refcode is:"&str(refcode) vloadif(dpath|"purchord.vws") order change key "[Order_Nr]" data query execute "delpurch.dfq" index "delpurch.idx" ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ [Order_Nr] = refcode and not (deleted) ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ ' data find "[Order_Nr]" equal refcode options "" if cerror ' if none - then return x = messbox(" Purchase Order not found - report"&refcode&"to Head Office ",0,0,1) return (0) elseif records > 1 x = messboxwait(" More than one Purchase Order found - cannot delete ",0,0,1) x = messboxwait(" Report to Head Office ",0,0,1) return (0) end if lock-record [Order_Status] = "C" [Balance_OS] = 0 [Order_Cost] = 0 [Comments] = "Req'n deleted" [Order_Reference] = $altref [Del] = "" [Last_Update] = today [Updated_By] = userid write-record data delete record return (1) END FUNCTION 'DeletePurchord() FUNCTION AddToArray() local $new $newcust $hold h ' message "custname) is:"&str(custname) y = strtoary(custname) ' message "y) is:"&str(y) $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 CheckJobNr() ' finds Job & updates Cust_Ord local l1 c3 c2 c1 ques $reqstr fj ' screen clear box 1 1 sch scw 0 0 no-border $instruct = "" smartpoke $_ins 0 'message "In CheckJobNr - $jobstr is:"&str($jobstr) if $enternow = 1 fj = -2 else fj = PopJobs() end if while true repaint off if fj = -1 x = fentrybox(" Add Requisitions for Job Nr or {Esc} for Menu ",6,shopmask,jobnr) if x = -1 return (-1) elseif x = 0 if len(ptstr)=5 jobnr=left(ptstr,1)|"0"|right(ptstr,4) else jobnr = ptstr end if end if 'message "jobnr) is:"&str(jobnr) end if ' vloadif(dpath|"cusent3b.vw") ' load view for updating order change key "[Job_Nr]" data find "[Job_Nr]" equal jobnr options "g" ' find correct JOB if cerror messbox(" Job NOT entered - use INITIAL ORDER first ",0,0,1) return (-1) else #jobrec = precord custname = [CustOrd_Name] end if ' message "ptval) is:"&str(ptval) if days([Date_Of_Order])>days("30/04/97") if [Completed] = "Y" messboxwait(" Some req'ns may have been despatched already ",0,0,1) ' vloadif(dpath|"cus_ent7.vw") ' AddToArray() ' return (-2) end if end if ' message "L2503/Order Status is"&str([Order_Status]) if [Order_Status] = "I" ' Order_Status is "I" - OS changed after invoicing $i_state = "y" deladdr1 = [Delivery_Address_1] jobnr = [Job_Nr] custname = [Customer_Name] AddToArray() return (0) elseif $menu <> "boss" if days([Invoice_Date])>1 ' Invoiced messbox(" No alterations possible - already invoiced ",0,0,1) jobnr = "" vloadif(dpath|"cus_ent7.vw") return (-2) end if if [Order_Status] = "A" ' Initi"A"l messboxwait(" Order & Customer details NOT yet entered ",0,0,1) ' vloadif(dpath|"cus_ent7.vw") deladdr1 = [Delivery_Address_1] jobnr = [Job_Nr] custname = [Customer_Name] AddToArray() return (0) ' elseif [Order_Status] = "D" ' DESPATCHED ' messboxwait(" Some req'ns may have been despatched already ",0,0,1) ' messboxwait(" Order already despatched/invoiced - contact Head Office ",0,0,1) ' vloadif(dpath|"cus_ent7.vw") ' AddToArray() ' return (-2) elseif [Order_Status] = "U" ' "U"pdated deladdr1 = [Delivery_Address_1] jobnr = [Job_Nr] custname = [Customer_Name] AddToArray() return (0) elseif [Order_Status] = "V" ' Re"V"iew messbox(" No alterations possible - held for Review @ Head Office ",0,0,1) jobnr = "" vloadif(dpath|"cus_ent7.vw") return (-2) elseif [Order_Status] = "H" ' messbox(" No alterations possible - held for Review @ Head Office ",0,0,1) jobnr = "" vloadif(dpath|"cus_ent7.vw") return (-2) else deladdr1 = [Delivery_Address_1] jobnr = [Job_Nr] custname = [Customer_Name] AddToArray() return (0) ' messbox(" No alterations possible - already passed for Office Authorization ",0,0,1) ' jobnr = "" ' vloadif(dpath|"cus_ent7.vw") ' return (-2) end if else deladdr1 = [Delivery_Address_1] jobnr = [Job_Nr] custname = [Customer_Name] AddToArray() return (0) end if end while END FUNCTION ' CheckJobNr() FUNCTION PopJobs() local ljob ljobmax ls c1 c2 c3 ljob = 0 ljobmax = 0 for i = 1 to 6 ljob = len(jobs[i]) if ljob > ljobmax ljobmax = ljob end if end for c3 = int((scw-ljobmax)/2)+1 c1 = c3-2 if c1 <= 0 c1 = 1 end if redimension ptary[6] for i = 1 to 6 ptary[i] = jobs[i] end for x = arytostr(6) $jobstr = ptstr x = popuplist(8,c1,22,$jobstr,"{Esc} to enter new",1,0) if x = 0 jobnr = left(ptstr,6) return (0) elseif x = -1 jobnr = "" return (-1) end if END FUNCTION 'PopJobs() 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 ChooseSupplier() vloadif(dpath|"supplier.vws") order change physical order sort now dictionary "suppname" fields "[Name]" ascending repaint off while true y1 = format(" Choose Supplier making Charge ","M72") screen print 21 5 15 1 y1 x = bpopdb("supplier",6,"","[Name]","L42","[Supplier_Code]","L6","[Supplier_Code]",7,36,20,80,"",0) if x = 0 exit while elseif x = -1 screen clear box 1 1 sch scw 0 0 no-border return (-1) end if end while suppcode = ptstr suppname = [Name] END FUNCTION ' ChooseSupplier() FUNCTION EnterOverride() ' If $itemtype = "B", check Purchase Order entered vloadif(dpath|"besp_chk.vw") order change key "[Order_Nr]" data find "[Order_Nr]" equal refcode options "" if cerror x = EnterNewOverride() if x = -1 return (-1) end if vunloadif("besp_chk.vw") exit function else currentorder = precord orderby = [Ordered_By] purchorderdate = [Date_Ordered] prodcode = [Product_Code] delquot = "N/A" $comment = "Override charge" x = EnterNewOverride() if x = -1 return (-1) end if vunloadif("besp_chk.vw") exit function end if END FUNCTION ' EnterOverride() FUNCTION EnterNewOverride() local mess oldstrt deldate ' 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 CommissionRcvd() local receiptnr #widthrcvd #totalcost increment(dpath|"gds_rcvd.dat",1) receiptnr = "GI"|right("000000"|str(ptval),6) vloadif(dpath|"gds_rcvd.vws") #widthrcvd = 1 #totalcost = #ordlength * #widthrcvd * #unitcost ' message "#totalcost) is:"&str(#totalcost) data enter lock ' make assignments to GDS_RCVD [Date_Received] = date2(today) [Product_Supplier]= prodMRC [Supplier_Code] = "VAR003" [Branch] = left(refcode,1) [Receipt_Nr] = receiptnr [Status] = "A" [Order_Nr] = refcode [Product_Code] = prodcode [Width_Received] = #widthrcvd [Colour] = desMRC [Length_Received] = #ordlength ' enter quantity rec'd [Unit_Cost] = #unitcost [Total_Cost] = #totalcost [Last_Update] = today [Updated_By] = userid write-record vloadif(dpath|"cus_ent4.vw") END FUNCTION ' CommissionRcvd() FUNCTION ChooseLength() ' Enter & check Length while true $uos = [Unit_Of_Sale] ' message "3284/$itemtype is:"&str($itemtype) if $itemtype = "A" $mess2 = " Enter Quantity required " elseif $itemtype = "B" $mess2 = " Enter Length required (5cm steps) " elseif $itemtype = "C" $mess2 = " Enter Length required (5cm steps) " elseif $itemtype = "O" $mess2 = format("Enter"&prodMRC,"M36") elseif $itemtype = "F" if $uos = "U3" $mess2 = " ’’’Enter Labour cost ’’’ " else $mess2 = " ’’’Enter quantity/length " end if elseif $itemtype = "J" $mess2 = " Enter Quantity required " elseif $itemtype = "S" $mess2 = " Enter Quantity required " elseif $itemtype = "T" $mess2 = " Enter Quantity required " elseif $itemtype = "V" $mess2 = " Enter Length required (5cm steps) " elseif $itemtype = "W" $mess2 = " Enter Length required (5cm steps) " end if ' message "3309/$mess2 is:"&str($mess2) x = entryline($mess2,6,nr6,#ordlength,21,5,72) if x = -1 return (-1) end if if x = 0 if value(ptstr) = 0 continue while elseif $itemtype = "S" #ordlength = value(ptstr) exit while elseif round(mod(value(ptstr)*100,5),0)=0 or round(mod(value(ptstr)*100,5),0)=5 #ordlength = value(ptstr) exit while else ptstr = value(ptstr) x = round(ptstr*20,0)/20 #ordlength = fixed(@if(x #ordlength $resvn = 0 end if exit while end if end while repaint off END FUNCTION 'ChooseLength() FUNCTION UpdateLength() ' Enter & check Length while true $uos = [Unit_Of_Sale] if $itemtype = "A" $mess2 = " Enter Quantity required (max"&str(#maxupd)|") " elseif $itemtype = "B" $mess2 = " Enter Length required (max"&str(#maxupd)|" - 5cms steps)" ' $mess2 = " Enter Length required (5cm steps) " elseif $itemtype = "C" $mess2 = " Enter Length required (max"&str(#maxupd)|" - 5cms steps)" ' $mess2 = " Enter Length required (5cm steps) " elseif $itemtype = "O" $mess2 = format("Enter"&prodMRC&"(max"&str(#maxupd)|")","M36") elseif $itemtype = "F" if $uos = "U3" $mess2 = " ’’’Enter Labour cost (max"&str(#maxupd)|") " else $mess2 = " ’’’Enter quantity/length (max"&str(#maxupd)|") " end if elseif $itemtype = "J" $mess2 = " Enter Quantity required (max"&str(#maxupd)|") " elseif $itemtype = "S" $mess2 = " Enter Quantity required (max"&str(#maxupd)|") " ' $mess2 = " Enter Quantity required " elseif $itemtype = "T" $mess2 = " Enter Quantity required (max"&str(#maxupd)|") " ' $mess2 = " Enter Quantity required " elseif $itemtype = "V" $mess2 = " Enter Length required (max"&str(#maxupd)|") " ' $mess2 = " Enter Length required (5cm steps) " elseif $itemtype = "W" $mess2 = " Enter Length required (max"&str(#maxupd)|") " ' $mess2 = " Enter Length required (5cm steps) " end if x = entryline($mess2,6,nr6,#ordlength,21,5,72) if x = -1 return (-1) end if if x = 0 if value(ptstr) = 0 continue while elseif $itemtype = "S" #ordlength = value(ptstr) exit while elseif round(mod(value(ptstr)*100,5),0)=0 or round(mod(value(ptstr)*100,5),0)=5 #ordlength = value(ptstr) exit while else ptstr = value(ptstr) x = round(ptstr*20,0)/20 #ordlength = fixed(@if(x #ordlength $resvn = 0 end if exit while end if end while repaint off END FUNCTION 'UpdateLength() FUNCTION F2M() local lx #feet #inch i z h msg1 lx = len($meas) #feet = "" #inch = "" for i = 1 to lx z = mid($meas,i,1) if z = "'" exit for else #feet = #feet|z end if end for if len(#feet) <> lx for h = i+1 to lx z = mid($meas,h,1) #inch = #inch|z end for if val(#feet) > 0 if val(#inch) > 11 messboxwait(" Idiot!! Whoever heard of"&#feet|"'"|#inch|"? - re-enter ",0,0,1) $meas = 0 #ordlength=0 return (1) end if end if $meas=fixed((val(#feet)+(val(#inch)/12))/#conv_f2m,2) else $meas=fixed(val(#feet)/#conv_f2m,2) end if return (0) END FUNCTION ' F2M() FUNCTION MultipleCuts() local messq sr sc mbox c maxlen $len while true ' cycle thru to enter lengths x = fentrybox(" TOTAL nr of similar (other than length) requisitions",2,"*2{[1234567890]}","") if x = -1 return (-1) end if #nrrequsns = value(ptstr) ordref = "" specterm = "" #reqnlen = "" #totreqn = 0 for i = 1 to #nrrequsns $suffix = case i (1,"st")(2,"nd")(3,"rd") else "th" while true x = fentrybox(" Length of"&str(i)|$suffix&"requisition ",5,"*5{[1234567890.]}",#length) if x = 0 if value(ptstr) = 0 continue while elseif $itemtype = "S" #ordlength = value(ptstr) exit while elseif round(mod(value(ptstr)*100,5),0)=0 or round(mod(value(ptstr)*100,5),0)=5 ' #length = value(ptstr) ptstr = value(ptstr) #length = fixed(ptstr,2) screen clear box 22 1 22 scw 0 0 no-border exit while else ptstr = value(ptstr) x = round(ptstr*20,0)/20 #length = fixed(@if(xmaxlen maxlen=l end if end for sc=sc-maxlen-4 'message "sc is:"&str(sc) x = PopLengths(sr,sc,21,#reqnlen,"",1,0) ' show list screen shortrestore dsa $prevscn = psa messbox(str(#nrrequsns)&"cuts totalling"&fixed(#totreqn,2)|"m ("|fixed(#area,2)|"sqm)? (y/n) ",1,1,1) if ptstr == "y" screen shortrestore $prevscn repaint off exit while else screen shortrestore $prevscn #reqnlen = "" #totreqn = #length continue while end if end while ConfirmMultiple_yn() END FUNCTION 'MultipleCuts() FUNCTION ConfirmMultiple_yn() 'Obtain reference & show confirmation box $unit = [Unit_Desc] $uos = [Unit_Of_Sale] if $itemtype = "B" MultPurchOrderDetails() ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Calculate which Price to use - (SMLR - disc) at date of order ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ else if days(custorderdate) < days($effecdate) #unitcost = round($prev_R*(1-($disc/100)),2) ' ROLL price used for all other prods ' #unitcost = $prev_R*(1-($disc/100)) ' ROLL price used for all other prods else #unitcost = round($smlr*(1-($disc/100)),2) ' #unitcost = $smlr*(1-($disc/100)) end if end if #newliststck = "1" ' $itemtype = "C" 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 order change index "current.idx" x = strtoary(#reqnlen) ' for i = 1 to #nrrequsns error off #refnr = filemax([#refnr]) 'message "#refnr is:"&str(#refnr) if cerror #refnr = 0 end if ' x=apinfo(ap_filep) ' message "Screen is:"&str(x) refcode = jobnr|"-"|str(right("00"|str(#refnr+1),2)) 'message "refcode is:"&str(refcode) $stat = "I" #ordlength = ptary[i] ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ 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 if $itemtype = "B" $rollnr = "BESPOK" else $rollnr = "00000/00" end if $auth = @if(priceauthority = blank,"None",priceauthority) ' vloadif(dpath|"cus_ent4.vw") ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Assign revised figures to REQUSN & PURCHORD ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ ' WriteRecord() if $itemtype = "B" vloadif(dpath|"cus_ent4.vw") WriteRecord() EnterMultPurchOrder() else Check_CCW() vloadif(dpath|"cus_ent4.vw") WriteRecord() end if vloadif(dpath|"cus_ent4.vw") end for END FUNCTION ' ConfirmMultiple_yn() 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 MultPurchOrderDetails() local mess oldstrt 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 ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ 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(#totreqn)|"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(#totreqn) > 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(#totreqn) > 20 messline(" Length ordered is"&format(str(#totreqn),"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(#totreqn) < 20 messline(" Length ordered is"&format(str(#totreqn),"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 vloadif(dpath|"supplier.vws") suppname = filelookup([Supplier_Code],[Name],suppcode) vunloadif("supplier.vws") vloadif(dpath|"cus_ent4.vw") ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Enter comments & delivery address re Purchase ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if upd_new = "NEW" $comment = "None" end if x = colpopup(2,2,13,"Warehouse’ Branch To’Site Collect","Delivery",1,0,15,12,0,7) if ptstr = "Warehouse’" $del = "W" elseif ptstr = "Branch" screen shortrestore dsa x = colpopup(2,16,13,"Fulham Raynes Putney Sheen","Branch",1,0,10,13,0,7) $deladdr = ptstr $del = left(ptstr,1) elseif ptstr = "To’Site" $del = "S" while true screen shortrestore dsa x = entryline(" Site address/notes ",30,"","",21,5,72) if x = 0 if ptstr = "" continue while end if $deladdr = ptstr exit while end if end while elseif ptstr = "Collect" $del = "O" end if while true x = entryline(" Any comments on Purchase Order ",40,"",$comment,21,5,72) if x = 0 $comment = ptstr exit while end if end while screen clear box 22 5 22 77 0 0 no-border ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Supplier's reference ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if upd_new = "NEW" ordref = "" while true x = entryline(" "|suppname|"'s reference ",20,"*20{XU}",ordref,21,5,72) if x = 0 ordref = ptstr if ordref = "" messline(" Must enter Supplier's reference! ",0,0,1,21,5,72) continue while else exit while end if end if end while else ordref = $altref end if screen clear box 22 5 22 77 0 0 no-border ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Ordered by? ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ repaint off y2 = format(" Enter name of person ordering from Supplier ","M72") screen print 21 5 fgp bgp y2 OrderedBy() y2 = format(" ","M72") screen print 21 5 fgp bgp y2 ' x = messline("’"|fixed(#totreqn,2)&$unit&"ordered by"&orderby&"on"&purchorderdate&"? (y/n/Esc) ",1,0,0,21,5,72) x = messline("’TOTAL of"&fixed(#totreqn,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 END FUNCTION ' MultPurchOrderDetails() FUNCTION EnterMultPurchOrder() vloadif(dpath|"ent_pord.vw") data enter lock [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 ' EnterMultPurchOrder() FUNCTION Authorise() vloadif(dpath|"cus_ent7.vw") order change physical vloadif(dpath|"cus_ent8.vw") order change index "current.idx" repaint on repaint Title_B() repaint off $fail = "" $update = "N" r1 = 7 while true x = CheckOrder() 'message "Leaving CheckOrder - x is:"&str(x) if x = -1 messbox(" Abandon Authorisation process? (y/n) ",1,0,1) if ptstr == "y" exit while else continue while end if end if exit while end while END FUNCTION ' Authorise() FUNCTION CheckOrder() vloadif(dpath|"authoriz.vw") order change key "[Job_Nr]" data find "[Job_Nr]" equal jobnr options "" if cerror ' if none - then return x = messboxwait(" Job Nr not found ",0,1,1) return (1) end if if left([Job_Nr],1)<>"P" if [ConfPrt]<>"Y" messboxwait(" Cannot authorise - Order NOT yet printed ",0,0,1) return (1) end if end if if [Order_Status] = "P" messboxwait(" This Order has already been passed ",0,0,1) return (1) end if error off #netinv = [Net_Invoice] ' message "#netinv is:"&str(#netinv) #totcost = tablesum([Cost]) ' message "#totcost is:"&str(#totcost) #margin = (#netinv-#totcost)/#netinv #percentmargin = round(#margin*100,2) ' message "#percentmargin is:"&str(#percentmargin) if #margin < #margin_A screen print 1 3 12 0 "Gross Margin" screen print 2 6 12 0 fixed(#percentmargin,1)|"%" elseif #margin < #margin_B screen print 1 3 14 0 "Gross Margin" screen print 2 6 14 0 fixed(#percentmargin,1)|"%" elseif #margin < #margin_C screen print 1 3 10 0 "Gross Margin" screen print 2 6 10 0 fixed(#percentmargin,1)|"%" elseif #margin < #margin_D screen print 1 3 14 0 "Gross Margin" screen print 2 6 14 0 fixed(#percentmargin,1)|"%" else screen print 1 3 12 0 "Gross Margin" screen print 2 6 12 0 fixed(#percentmargin,1)|"%" end if CopyAddresses() x = ReviewAddr() if x = -1 return (-1) elseif x = 0 return (0) elseif x = 1 return (1) end if END FUNCTION ' CheckOrder() FUNCTION ReviewAddr() while true ShowDetails() y1 = format("Change {C}ustomer/{D}elivery addresses or {S}undry details ","M70") screen print 21 5 15 1 y1 y2 = format("{F10} to continue - {Esc} to abandon","M70") screen print 22 5 15 1 y2 while true x = inchar ' message "x is:"&str(x) if x = 99 ' c - change Customer x = CustomerAddr() if x <> -1 $update = "Y" end if exit while elseif x = 100 ' d - change DELIVERY x = DeliveryAddr() if x <> -1 $update = "Y" end if messbox(" Do you want the invoice to show the Delivery address? (y/n)",1,1,1) if ptstr == "y" $showdel = "Y" else $showdel = "N" end if exit while elseif x = 115 ' s - change SUNDRY x = CheckCustomer() if x <> -1 $update = "Y" end if exit while elseif x = 324 ' F10 - continue if $update = "Y" messbox(" Customer details changed - write to file? (y/n) ",1,1,1) if ptstr == "y" WriteDetails() $update = "N" else messbox(" Then why bother to change them? - write to file? (y/n) ",1,0,1) if ptstr == "y" WriteDetails() $update = "N" else messbox(" You'll be found out - don't say I didn't warn you ",0,1,1) end if end if end if if tablecount([Product_MRC]) = 0 $fail = " NO requisitions for job" x = ReferShop() if x = 0 ' no more unauth's return (0) end if end if x = MarginCheck() return (0) elseif x = 763 ' Esc - abort return (-1) end if end while end while END FUNCTION 'ReviewAddr() FUNCTION MarginCheck() ' 1=failed; 0=passed local $br $br = [Branch] if #margin < #margin_A repaint off messboxwait(" This Order has NOT been passed - referred to DAVIDG ",0,0,1) screen clear box 1 1 sch scw 0 0 no-border repaint off cat = "MARGIN" mess1 = jobnr&"- BAD Gross Margin"&right("’’’’’’"|fixed(#percentmargin,1),6)|"%"&"- Net invoice"&right("’’’’’’’’"|currency(#netinv),8)&"- total costs"&right("’’’’’’’’"|currency(#totcost),8) 'L287 if $br <> "P" x = exception(userid,today,time24,cat,mess1) end if x = WriteHOLD() return (0) elseif #margin < #margin_B ' 25-30% repaint off messboxwait(" This Order has been passed but reported ",0,0,1) screen clear box 1 1 sch scw 0 0 no-border repaint off cat = "MARGIN" mess1 = jobnr&"- LOW Gross Margin"&right("’’’’’’"|fixed(#percentmargin,1),6)|"%"&"- Net invoice"&right("’’’’’’’’"|currency(#netinv),8)&"- total costs"&right("’’’’’’’’"|currency(#totcost),8) 'L287 if $br <> "P" x = exception(userid,today,time24,cat,mess1) end if x = WritePASS() return (0) elseif #margin < #margin_C ' 30-40% repaint off messbox(" This Order has been passed ",0,0,1) screen clear box 1 1 sch scw 0 0 no-border repaint off x = WritePASS() return (0) elseif #margin < #margin_D ' 40-50% repaint off messboxwait(" This Order has been passed but reported ",0,0,1) screen clear box 1 1 sch scw 0 0 no-border repaint off cat = "MARGIN" mess1 = jobnr&"- HIGH Gross Margin"&right("’’’’’’"|fixed(#percentmargin,1),6)|"%"&"- Net invoice"&right("’’’’’’’’"|currency(#netinv),8)&"- total costs"&right("’’’’’’’’"|currency(#totcost),8) 'L287 if $br <> "P" x = exception(userid,today,time24,cat,mess1) end if ' x = exception(userid,today,time24,cat,mess1) x = WritePASS() return (0) else repaint off messboxwait(" This Order has NOT been passed - referred to DAVIDG ",0,0,1) screen clear box 1 1 sch scw 0 0 no-border repaint off cat = "MARGIN" mess1 = jobnr&"- CRITICAL Gross Margin"&right("’’’’’’"|fixed(#percentmargin,1),6)|"%"&"- Net invoice"&right("’’’’’’’’"|currency(#netinv),8)&"- total costs"&right("’’’’’’’’"|currency(#totcost),8) 'L287 if $br <> "P" x = exception(userid,today,time24,cat,mess1) end if x = WriteHOLD() return (0) end if END FUNCTION ' MarginCheck() FUNCTION CheckCustomer() local $nophone ' update Title while true y1 = format(" Select Title ","M70") screen print 21 5 15 1 y1 y = popuplist(11,5,18,"Mr Mrs Mr’&’Mrs Miss Ms Other Ltd’Co","",1,0) if ptstr = "Other" while true x = entryline(" Enter title ",20,"","",21,5,70) if x = 0 cust_title = ptstr exit while end if end while elseif ptstr = "Ltd’Co" cust_title = "" exit while else cust_title = ptstr x = entryline(" Enter Forename or Initial ",35,"","",21,5,70) cust_title = cust_title&proper(ptstr) end if exit while end while ' update Contact Name while true y1 = format(" ","M70") screen print 21 5 15 1 y1 x = entryline(" Contact name (if different to customer name) ",45,"",custcontact,21,5,70) if x = 0 custcontact = ptstr exit while end if end while $nophone = "N" while true while true if hometel = "N/P" hometel = "0" end if x = entryline(" Home 'phone number (eg 0-171-498-1453) - {Esc} if none ",15,"*15{[1234567890\-]}",hometel,21,5,70) if x = 0 if ptstr = "0" hometel = "N/P" else hometel = ptstr $nophone = "Y" exit while end if elseif x = -1 hometel = "N/P" exit while end if end while while true if offtel = "N/P" offtel = "0" end if x = entryline(" Office 'phone number (eg 0-171-498-1453) - {Esc} if none ",15,"*15{[1234567890\-]}",offtel,21,5,70) if x = 0 if ptstr = "0" offtel = "N/P" else offtel = ptstr $nophone = "Y" exit while end if elseif x = -1 offtel = "N/P" exit while end if end while while true if mobile = "N/P" mobile = "0" end if x = entryline(" Mobile 'phone number (eg 0860-291565) - {Esc} if none ",15,"*15{[1234567890\-]}",mobile,21,5,70) if x = 0 if ptstr = "0" mobile = "N/P" else mobile = ptstr $nophone = "Y" exit while end if elseif x = -1 mobile = "N/P" exit while end if end while if $nophone = "N" x = messline(" You cannot be serious! Everyone has a 'phone. Re-enter? (y/n) ",1,1,1,21,5,70) if ptstr=="y" continue while else exit while end if else exit while end if end while while true if offax = "N/P" offax = "0" end if x = entryline(" Fax number (eg 0-171-498-1455) - {Esc} if none ",15,"*15{[1234567890\-]}",offax,21,5,70) if x = 0 offax = @if(ptstr=="0","N/P",ptstr) exit while elseif x = -1 offax = "N/P" exit while end if end while END FUNCTION 'CheckCustomer() FUNCTION CustomerAddr() while true x = entryline(" Customer's Address - Line 1 ",35,"",custaddr1,21,5,70) if x = 0 custaddr1 = proper(ptstr) exit while end if end while while true x = entryline(" Customer's Address - Line 2 ",35,"",custaddr2,21,5,70) if x = 0 custaddr2 = proper(ptstr) exit while end if end while while true x = entryline(" Customer's Address - Town/City ",20,city,custcity,21,5,70) if x = 0 custcity = ptstr exit while end if end while while true x = entryline(" Customer's Postcode ",8,"AU*7{[A-Za-z1234567890\ ]U}",custpostcode,21,5,70) if x = 0 custpostcode = ptstr exit while else end if end while END FUNCTION 'CustomerAddr() FUNCTION DeliveryAddr() 'message "enter deladdr using deladdr" while true x = entryline(" Enter Delivery Address - Line 1 ",35,"",deladdr1,21,5,70) if x = 0 deladdr1 = proper(ptstr) exit while end if end while while true x = entryline(" Enter Delivery Address - Line 2 ",35,"",deladdr2,21,5,70) if x = 0 deladdr2 = proper(ptstr) exit while end if end while while true x = entryline(" Enter Town/City ",20,"",deladdr3,21,5,70) if x = 0 deladdr3 = ptstr exit while end if end while while true x = entryline(" Delivery Postcode ",8,"AU*7{[A-Za-z1234567890\ ]U}",deladdr4,21,5,70) if x = 0 deladdr4 = ptstr exit while else end if end while END FUNCTION ' DeliveryAddr() FUNCTION ReturnToMenu() '====================================================================== ' check that any job with Order_status "I" is changed to "U" '====================================================================== ' message "$i_state is:"&str($i_state) if $i_state="y" ' message "jobnr is:"&str(jobnr) vloadif(dpath|"cust_ord.vws") order change key "[Job_Nr]" data find "[Job_Nr]" equal jobnr options "" if cerror ' if none - then return messboxwait(" Job Nr not found ",0,0,1) else if [Order_Status]="I" lock-record let [Order_Status]="U" write-record end if end if end if screen clear box 1 1 sch scw 0 0 no-border repaint off file unload all ' transfer cpath|"pm_menu.psl" in-memory END FUNCTION ' ReturnToMenu() FUNCTION ShowDetails() local c1 c2 c3 c4 d1 d2 d3 d4 cc1 cr1 cc2 cr2 dc1 dr1 dc2 dr2 pc1 pr1 pc2 pr2 \ ordets p1 p2 p3 p4 p5 p6 p7 df if $showdel = "Y" df = 15 else df = 8 end if cr1 = 6 cc1 = 2 cr2 = cr1+5 cc2 = cc1+37 dr1 = cr1 dc1 = 42 dr2 = cr2 dc2 = dc1+37 pr1 = cr2+1 pc1 = cc1+14 pr2 = pr1+8 pc2 = pc1+50 screen clear box cr1 cc1 cr2 cc2 15 1 c1 = left(custaddr1|"’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’",35) c2 = left(custaddr2|"’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’",35) c3 = left(custcity|"’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’",35) c4 = left(custpostcode|"’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’",35) screen print cr1 cc1+1 15 1 "’Customer's address’" screen print cr1+1 cc1+2 15 1 c1 screen print cr1+2 cc1+2 15 1 c2 screen print cr1+3 cc1+2 15 1 c3 screen print cr1+4 cc1+2 15 1 c4 screen save cr1 cc1 cr2 cc2 custaddr screen clear box dr1 dc1 dr2 dc2 df 1 d1 = left(deladdr1|"’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’",35) d2 = left(deladdr2|"’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’",35) d3 = left(deladdr3|"’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’",35) d4 = left(deladdr4|"’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’",35) screen print dr1 dc1+1 df 1 "’Delivery address’" screen print dr1+1 dc1+2 df 1 d1 screen print dr1+2 dc1+2 df 1 d2 screen print dr1+3 dc1+2 df 1 d3 screen print dr1+4 dc1+2 df 1 d4 if $showdel = "N" screen print dr2 dc1+1 df 1 "’Not to be shown on invoice’" end if screen save dr1 dc1 dr2 dc2 deladdr screen clear box pr1 pc1 pr2 pc2 15 1 p1 = format("Title: ’ "|left(cust_title|"’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’",35),"L47") p2 = format("Name: ’ "|left(custname|"’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’",35),"L47") p3 = format("Contact: ’"|left(custcontact|"’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’",35),"L47") p4 = format("Office tel:’"|left(offtel|"’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’",35),"L47") p5 = format("Home tel: ’"|left(hometel|"’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’",35),"L47") p6 = format("Fax nr:’’ ’"|left(offax|"’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’",35),"L47") p7 = format("Mobile nr: ’"|left(mobile|"’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’",35),"L47") screen print pr1 pc1+1 15 1 "’Sundry details’" screen print pr1+1 pc1+2 15 1 p1 screen print pr1+2 pc1+2 15 1 p2 screen print pr1+3 pc1+2 15 1 p3 screen print pr1+4 pc1+2 15 1 p4 screen print pr1+5 pc1+2 15 1 p5 screen print pr1+6 pc1+2 15 1 p6 screen print pr1+7 pc1+2 15 1 p7 screen save pr1 pc1 pr2 pc2 ordets END FUNCTION 'ShowDetails() FUNCTION CopyAddresses() custaddr1 = [Address_1] custaddr2 = [Address_2] custcity = [City/Town] custpostcode = [Postcode] custcontact = [Contact_Name] cust_title = [Cust_Title] custname = [Customer_Name] hometel = [Home_Tel] offtel = [Office_Tel] mobile = [Mobile/Other_Nr] offax = [Office_Fax] deladdr1 = [Delivery_Address_1] deladdr2 = [Delivery_Address_2] deladdr3 = [Del_City] deladdr4 = [Del_Postcode] $showdel = [PDA] END FUNCTION 'CopyAddresses() FUNCTION WriteDetails() ' write customer & job details to CUSENT3B lock-record [Cust_Title] = cust_title ' [Customer_Name] = custname ' CANNOT change this anyway [Contact_Name] = custcontact [Office_Tel] = offtel [Home_Tel] = hometel [Office_Fax] = offax [Mobile/Other_Nr] = mobile [Address_1] = custaddr1 [Address_2] = custaddr2 [City/Town] = custcity [Postcode] = custpostcode [Delivery_Address_1] = deladdr1 [Delivery_Address_2] = deladdr2 [Del_City] = deladdr3 [Del_Postcode] = deladdr4 [PDA] = $showdel [Last_Update] = today [Updated_By] = userid write-record END FUNCTION ' WriteDetails() FUNCTION UpdApptRecs() local #apptnr repaint off vloadif(dpath|"bookappt.vw") order change key "[Job_Nr]" data query execute "job_reqn.dfq" index "upd_recs.idx" ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ QUERY is: [Job_Nr] = jobnr ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if cerror ' if none - then return return (0) ' no appts made yet end if for i = 1 to records $dayftr = left([DFA],11) #apptnr = [Appointment_Order] lock-record [Entered_By] = userid [Date_Altered] = today [Time] = now [Status] = $newstat write-record repaint off vloadif(dpath|"apptdate.vws") ' message "jobnr is:"&str(jobnr) order change key "[DayFitter]" data find "[DayFitter]" equal $dayftr options "" if cerror return (0) end if lock-record dbput("[B"|str(#apptnr)|"]",$newstat) write-record vloadif(dpath|"bookappt.vw") data goto record next end for END FUNCTION 'UpdApptRecs() FUNCTION ReferShop() ' change messbox to confirm send back to shop & show Job Nr messboxwait($fail&"- resolve problem & re-process ",0,0,1) vloadif(dpath|"authoriz.vw") repaint off $newstat = "V" lock-record [Order_Status] = $newstat write-record #recnr = record UpdApptRecs() vloadif(dpath|"authoriz.vw") return (0) END FUNCTION ' ReferShop() FUNCTION WriteHOLD() ' High or Low GP - refer to DG vloadif(dpath|"authoriz.vw") repaint off $newstat = "H" lock-record [Order_Status] = $newstat write-record #recnr = record UpdApptRecs() vloadif(dpath|"authoriz.vw") return (0) END FUNCTION ' WriteHOLD() FUNCTION WritePASS() repaint off vloadif(dpath|"authoriz.vw") $newstat = "P" lock-record [Order_Status] = $newstat write-record #recnr = record UpdApptRecs() vloadif(dpath|"authoriz.vw") return (0) END FUNCTION 'WritePASS() function messbox(msg,q,c,e) 'D. Lynn ' msg=message q=filter for yes/no (0=no filter,1=filter) ' c=color (0=error colors, 1=pleasing) e=allow escape from "q" filter local fc2 bc2 fc1 bc1 r1 r2 c1 c2 c3 lmsg mbox k err err = 0 k=0 fc1=14 bc1=1 fc2=14 bc2=1 mbox = scrwidth lmsg=len(msg) if lmsg + 4 > scrwidth return (-2) end if r1 = scr-2 r2 = scr+2 c3 = int((mbox-lmsg)/2)+1 c1 = c3-2 c2 = c3+lmsg+1 if c1 <= 0 c1 = 1 end if if (c1-1) < 12 while (c1-1) < (scrwidth-c2) c2=c2+1 end while end if if c2 > scrwidth return (-2) end if ' ############## New for SHADE ############################## screen save r1 c1 r2+1 c2+1 psa 'NEW SCREEN SAVE r1+1 c1+1 r2+1 c2+1 $screen 'NEW _shade() 'NEW SCREEN SHORTRESTORE $screen 'NEW ' ############## END of New for SHADE ####################### screen clear box r1 c1 r2 c2 fc1 bc1 screen print scr c3 fc2 bc2 msg screen save r1 c1 r2 c2 dsa if q=0 wait 2 else WHILE "yn" !! k locate scr (c3+lmsg) 1 k=inchar if e=0 and k={Esc} err = -1 exit while end if k = lower(chr(k)) END WHILE locate scr (c3+lmsg) 0 end if screen shortrestore psa if k = 0 ptstr = NULL else ptstr = k end if return (err) end function 'messbox() FUNCTION _shade() LOCAL row1 rows1 col1 cols1 x y row1=$screen[3] col1=$screen[7] rows1=$screen[5] cols1=$screen[9] SMARTPEEK $_rev ver IF VAL(LEFT(ver,1))>1 count=1 ELSE count=0 END IF FOR y=0 TO cols1+count $screen[(2+SCRMODE)*(rows1*(cols1+1)+y)+12+SCRMODE]=0x08 END FOR FOR x=0 TO rows1 $screen[(2+SCRMODE)*(x*(cols1+1)+cols1+count)+12+SCRMODE]=0x08 END FOR END FUNCTION FUNCTION WriteDelete() lock-record [Reference_Nr] = left(refcode,7)|"00" [Job_Nr] = "" [Status] = "D" [Date_Status_Changed] = today [Created/Changed_By] = userid [RollNr] = "" ' [Product_Code] = "" ' [Product_MRC] = "Deleted" ' [Description_MRC] = "" ' [Item_Type] = "" ' [Length_Quantity] = "" ' [Date_Requisitioned] = today ' [Cost] = "" ' [Comment] = $auth ' [Width] = "" ' [CCW_Code] = "" ' [R_Backing] = "" ' [prodrec] = "" data delete record write-record #recnr = record vloadif(dpath|"cus_ent7.vw") END FUNCTION 'WriteDelete() FUNCTION AmendReqns() ' show navrecs of all reqns - in vloadif(dpath|"cus_ent7.vw") vloadif(dpath|"cus_ent7.vw") order change index "current.idx" ' order change index ipath|jobidx Title_B() ptval=0 while true ptval = navrecs() if ptval = {U} or ptval = {u} $altlen = "Y" x = UpdateReqn() ' 0=updated; 1=NOT updated Title_B() elseif ptval = {D} or ptval = {d} x = DeleteReqn() Title_B() elseif ptval = {R} or ptval = {r} x = ReAllocate() Title_B() elseif ptval = {F10} messline(" Finished with all Requisitions for"&jobnr|"? (y/n)",1,1,1,21,5,72) if ptstr == "y" if records > 0 if filemin([Cost]) = 0 ' check for Zero costs messbox(" One or more items not costed ",0,0,1) y2 = format("{R}eallocate - {U}pdate reqn - {D}elete reqn - {F10} finishes","M72") screen print 21 5 fgp bbd y2 continue while else return (-1) end if else return (-1) end if return (-1) else repaint off vunloadif("cus_ent7.vw") y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72") return (0) end if end if end while END FUNCTION ' AmendReqns() FUNCTION UpdateReqn() ' in vloadif(dpath|"cus_ent7.vw") local s_prodsel1 s_prodsel2 s_prodsel3 s_prodshw cdel = CheckDelivered() 'cdel = due out but NOT del'd if cdel > 0 messbox("’Delivered or scheduled for delivery; go to Diary to `un'deliver? ",1,0,1) if ptstr == "y" Background() file unload all execute "alt_appt.rf3" in-memory end if return (1) elseif cdel = -1 messboxwait(" Cutting Ticket already printed - cannot update ",0,0,1) return (1) end if $rollnr = [RollNr] refcode = [Reference_Nr] prodcode = [Product_Code] 'message "prodcode - L4848 - is:"&str(prodcode) prodMRC = [Product_MRC] 'message "prodmrc - L4848 - is:"&str(prodMRC) desMRC = [Description_MRC] 'message "desmrc - L4848 - is:"&str(desmrc) $itemtype = [Item_Type] 'message "$itemtype is:"&str($itemtype) #ordlength = [Length_Quantity] #origlength = [Length_Quantity] $auth = [Comment] #ordwidth = [Width] $backing = [R_Backing] #prodrec = [prodrec] 'message "#prodrec is:"&str(#prodrec) $ccwcode = [CCW_Code] #reqnrec = record #maxupd = [Quant_OS] #bal_os = [Quant_OS] #origcost = [Cost_OS] repaint off upd_new = "UPD" case $itemtype when "C" $prodend = "A" while true if $rollnr <> "00000/00" messline(" Are you altering length? (y/n) ",1,1,1,21,5,72) if ptstr == "y" messline(" Existing Allocation ("|$rollnr|") may be removed - continue? (y/n) ",1,0,1,21,5,72) if ptstr == "n" y2 = format("{R}eallocate - {U}pdate reqn - {D}elete reqn - {F10} finishes","M72") screen print 21 5 fgp bbd y2 return (1) end if if CheckBalance() = 1 return (1) end if else $altlen = "N" messboxwait(" This requisition will be deleted - re-enter with correct details ",0,0,1) x = DeleteReqn() Title_B() repaint off end if end if screen save 1 1 6 scw s_prodsel1 screen save 7 1 20 42 s_prodsel2 screen save 21 1 sch scw s_prodsel3 vloadif(dpath|"prodshw"|$prodend|".vw") order change index ipath|"stckcarp.idx" data find "[Product_Code]" equal prodcode options "" ' data goto record record-number #prodrec repaint on repaint screen shortrestore s_prodsel1 screen shortrestore s_prodsel2 screen shortrestore s_prodsel3 y2 = format("","M72") screen print 21 5 fgp bbd y2 #prodrec = record prodcode = [Product_Code] ' message "prodcode -L880- is:"&str(prodcode) $backing = [Backing] repaint off vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"stckcarp.idx" data goto record record-number #prodrec x = UpdateEntries() repaint off vloadif(dpath|"cus_ent7.vw") order change index "current.idx" Title_B() repaint on return (0) end while when "A" $prodend = "A" while true screen save 1 1 6 scw s_prodsel1 screen save 7 1 20 42 s_prodsel2 screen save 21 1 sch scw s_prodsel3 vloadif(dpath|"prodshw"|$prodend|".vw") order change index ipath|"stckancl.idx" data goto record record-number #prodrec repaint on repaint screen shortrestore s_prodsel1 screen shortrestore s_prodsel2 screen shortrestore s_prodsel3 y2 = format("","M72") screen print 21 5 fgp bbd y2 #prodrec = record prodcode = [Product_Code] ' message "prodcode -L917- is:"&str(prodcode) $backing = [Backing] repaint off vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"stckancl.idx" data goto record record-number #prodrec x = UpdateEntries() repaint off vloadif(dpath|"cus_ent7.vw") order change index "current.idx" Title_B() repaint on exit while end while when "F" $prodend = "A" while true screen save 1 1 6 scw s_prodsel1 screen save 7 1 20 42 s_prodsel2 screen save 21 1 sch scw s_prodsel3 vloadif(dpath|"prodshw"|$prodend|".vw") order change index ipath|"labour.idx" data goto record record-number #prodrec repaint on repaint screen shortrestore s_prodsel1 screen shortrestore s_prodsel2 screen shortrestore s_prodsel3 y2 = format("","M72") screen print 21 5 fgp bbd y2 #prodrec = record prodcode = [Product_Code] ' message "prodcode -L956- is:"&str(prodcode) $backing = [Backing] repaint off vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"labour.idx" data goto record record-number #prodrec x = UpdateEntries() repaint off vloadif(dpath|"cus_ent7.vw") order change index "current.idx" Title_B() repaint on exit while end while when "S" $prodend = "A" while true if $rollnr <> "00000/00" messline(" Are you altering length? (y/n) ",1,1,1,21,5,72) if ptstr == "y" messline(" Existing Allocation ("|$rollnr|") may be removed - continue? (y/n) ",1,0,1,21,5,72) if ptstr == "n" y2 = format("{R}eallocate - {U}pdate reqn - {D}elete reqn - {F10} finishes","M72") screen print 21 5 fgp bbd y2 return (1) end if if CheckBalance() = 1 return (1) end if else $altlen = "N" messboxwait(" This requisition will be deleted - re-enter with correct details ",0,0,1) x = DeleteReqn() Title_B() repaint off end if end if screen save 1 1 6 scw s_prodsel1 screen save 7 1 20 42 s_prodsel2 screen save 21 1 sch scw s_prodsel3 vloadif(dpath|"prodshw"|$prodend|".vw") order change index ipath|"stckcarp.idx" data find "[Product_Code]" equal prodcode options "" repaint on repaint screen shortrestore s_prodsel1 screen shortrestore s_prodsel2 screen shortrestore s_prodsel3 y2 = format("","M72") screen print 21 5 fgp bbd y2 #prodrec = record prodcode = [Product_Code] ' message "prodcode -L1013- is:"&str(prodcode) $backing = [Backing] repaint off vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"stckcarp.idx" data goto record record-number #prodrec x = UpdateEntries() repaint off vloadif(dpath|"cus_ent7.vw") order change index "current.idx" Title_B() repaint on return (0) end while when "V" $prodend = "A" while true screen save 1 1 6 scw s_prodsel1 screen save 7 1 20 42 s_prodsel2 screen save 21 1 sch scw s_prodsel3 vloadif(dpath|"prodshw"|$prodend|".vw") order change index ipath|"vinyl.idx" data goto record record-number #prodrec repaint on repaint screen shortrestore s_prodsel1 screen shortrestore s_prodsel2 screen shortrestore s_prodsel3 y2 = format("","M72") screen print 21 5 fgp bbd y2 #prodrec = record prodcode = [Product_Code] ' message "prodcode -L1047- is:"&str(prodcode) $backing = [Backing] repaint off vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"vinyl.idx" data goto record record-number #prodrec x = UpdateEntries() repaint off vloadif(dpath|"cus_ent7.vw") order change index "current.idx" Title_B() repaint on exit while end while when "J" $prodend = "B" while true screen save 1 1 6 scw s_prodsel1 screen save 7 1 20 35 s_prodsel2 screen save 21 1 sch scw s_prodsel3 vloadif(dpath|"prodshw"|$prodend|".vw") order change index ipath|"bespancl.idx" data goto record record-number #prodrec repaint on repaint screen shortrestore s_prodsel1 screen shortrestore s_prodsel2 screen shortrestore s_prodsel3 y2 = format("","M72") screen print 21 5 fgp bbd y2 #prodrec = record prodcode = [Product_Code] ' message "prodcode -L1086- is:"&str(prodcode) $backing = [Backing] repaint off vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"bespancl.idx" data goto record record-number #prodrec x = UpdateEntries() repaint off vloadif(dpath|"cus_ent7.vw") order change index "current.idx" ' order change index ipath|jobidx Title_B() repaint on exit while end while when "O" $prodend = "B" while true #override = [Cost] ' override or commission repaint off vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"bespancl.idx" data find "[Product_Code]" equal prodcode options "g" ' find correct JOB x = UpdateEntries() repaint off vloadif(dpath|"cus_ent7.vw") order change index "current.idx" ' order change index ipath|jobidx Title_B() repaint on exit while end while when "B" ' Line 822 $prodend = "B" $altref = "" if str(mid(prodcode,3,1))="7" 'message "prodcode) is:"&str(prodcode) messline(" Temporary Code, cannot alter. Delete and re-enter ",0,0,1,21,5,72) y2 = format("{R}eallocate - {U}pdate reqn - {D}elete reqn - {F10} finishes","M72") screen print 21 5 fgp bbd y2 return (1) end if while true if $rollnr <> "BESPOK" messline(" Goods already received - no alterations allowed ",0,0,1,21,5,72) y2 = format("{R}eallocate - {U}pdate reqn - {D}elete reqn - {F10} finishes","M72") screen print 21 5 fgp bbd y2 return (1) end if x = entryline(" Enter Supplier's alteration reference - {Esc} if none ",20,"",$altref,21,5,72) screen clear box 22 1 22 scw 0 0 no-border if x = -1 messline(" Contact Supplier for reference first ",0,0,1,21,5,72) y2 = format("{R}eallocate - {U}pdate reqn - {D}elete reqn - {F10} finishes","M72") screen print 21 5 fgp bbd y2 return (1) end if $altref = ptstr $Emess = "Req'n altered -"&prodcode&"- Supplier's new reference is"&$altref cat = "PUR_INVC" x = exception(userid,today,time24,cat,$Emess) screen save 1 1 6 scw s_prodsel1 screen save 7 1 20 35 s_prodsel2 screen save 21 1 sch scw s_prodsel3 vloadif(dpath|"prodshw"|$prodend|".vw") order change index ipath|"bespcarp.idx" data goto record record-number #prodrec repaint on repaint screen shortrestore s_prodsel1 screen shortrestore s_prodsel2 screen shortrestore s_prodsel3 y2 = format("","M72") screen print 21 5 fgp bbd y2 #prodrec = record prodcode = [Product_Code] ' message "prodcode -L1175- is:"&str(prodcode) $backing = [Backing] repaint off vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"bespcarp.idx" data goto record record-number #prodrec x = UpdateEntries() repaint off vloadif(dpath|"cus_ent7.vw") order change index "current.idx" Title_B() repaint on exit while end while when "T" $prodend = "B" while true screen save 1 1 6 scw s_prodsel1 screen save 7 1 20 35 s_prodsel2 screen save 21 1 sch scw s_prodsel3 vloadif(dpath|"prodshw"|$prodend|".vw") order change index ipath|"bsp_tile.idx" data goto record record-number #prodrec repaint on repaint screen shortrestore s_prodsel1 screen shortrestore s_prodsel2 screen shortrestore s_prodsel3 y2 = format("","M72") screen print 21 5 fgp bbd y2 #prodrec = record prodcode = [Product_Code] ' message "prodcode -L1214- is:"&str(prodcode) $backing = [Backing] repaint off vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"bsp_tile.idx" data goto record record-number #prodrec x = UpdateEntries() repaint off vloadif(dpath|"cus_ent7.vw") order change index "current.idx" Title_B() repaint on exit while end while when "W" $prodend ="B" while true screen save 1 1 6 scw s_prodsel1 screen save 7 1 20 35 s_prodsel2 screen save 21 1 sch scw s_prodsel3 vloadif(dpath|"prodshw"|$prodend|".vw") order change index ipath|"vinyl.idx" data goto record record-number #prodrec repaint on repaint screen shortrestore s_prodsel1 screen shortrestore s_prodsel2 screen shortrestore s_prodsel3 y2 = format("","M72") screen print 21 5 fgp bbd y2 #prodrec = record prodcode = [Product_Code] ' message "prodcode -L1252- is:"&str(prodcode) $backing = [Backing] repaint off vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"vinyl.idx" data goto record record-number #prodrec x = UpdateEntries() repaint off vloadif(dpath|"cus_ent7.vw") order change index "current.idx" Title_B() repaint on exit while end while end case END FUNCTION ' UpdateReqn() FUNCTION DeleteReqn() cdel = CheckDelivered() '0=none del'd if cdel > 0 messbox("’Delivered or scheduled for delivery; go to Diary to `un'deliver? ",1,0,1) if ptstr == "y" Background() file unload all execute "alt_appt.rf3" in-memory end if return (1) elseif cdel = -1 messboxwait(" Cutting Ticket already printed - cannot delete ",0,0,1) return (1) end if $rollnr = [RollNr] refcode = [Reference_Nr] prodcode = [Product_Code] 'message "prodcode -L456- is:"&str(prodcode) prodMRC = [Product_MRC] desMRC = [Description_MRC] $itemtype = [Item_Type] #ordlength = [Length_Quantity] $auth = [Comment] #ordwidth = [Width] $backing = [R_Backing] #prodrec = [prodrec] #reqnrec = record #maxupd = [Quant_OS] #bal_os = [Quant_OS] if $itemtype = "A" or $itemtype = "F" x = WriteDelete() order change physical x = delidxrec("current.idx",#recnr,1) if records = 0 messbox(" No more to delete ",0,1,1) return (1) end if order change index "current.idx" elseif $itemtype = "C" while true if $rollnr <> "00000/00" 'message "$rollnr is:"&str($rollnr) messline(" Existing Allocation ("|$rollnr|") will be removed - continue? (y/n) ",1,0,1,21,5,72) if ptstr == "n" y2 = format("{D}elete reqn - {F10} to finish","M72") repaint off screen print 21 5 fgp bbd y2 return (0) else x = AlterBalance() if x = 1 ' don't delete return (0) end if end if end if WriteDelete() ' order change physical x = delidxrec("current.idx",#recnr,1) if records = 0 messbox(" No more to delete ",0,1,1) return (1) end if repaint off ' vloadif(dpath|"cus_ent7.vw") order change index "current.idx" return (0) end while elseif $itemtype = "S" while true if $rollnr <> "00000/00" 'message "$rollnr is:"&str($rollnr) messline(" Existing Allocation ("|$rollnr|") will be removed - continue? (y/n) ",1,0,1,21,5,72) if ptstr == "n" y2 = format("{D}elete reqn - {F10} to finish","M72") repaint off screen print 21 5 fgp bbd y2 return (0) else x = AlterBalance() if x = 1 ' don't delete return (0) end if end if end if WriteDelete() ' order change physical x = delidxrec("current.idx",#recnr,1) if records = 0 messbox(" No more to delete ",0,1,1) return (1) end if repaint off ' vloadif(dpath|"cus_ent7.vw") order change index "current.idx" return (0) end while elseif $itemtype = "V" while true if $rollnr <> "NA" messline(" Existing Allocation ("|$rollnr|") will be removed - continue? (y/n) ",1,0,1,21,5,72) if ptstr == "n" y2 = format("{D}elete reqn - {F10} to finish","M72") screen print 21 5 fgp bbd y2 return (0) else x = AlterBalance() if x = 1 ' don't delete return (0) end if end if end if WriteDelete() ' #recnr = record order change physical x = delidxrec("current.idx",#recnr,1) if records = 0 messbox(" No more to delete ",0,1,1) return (1) end if repaint off ' vloadif(dpath|"cus_ent7.vw") order change index "current.idx" return (0) end while elseif $itemtype = "B" or $itemtype = "J" or $itemtype = "T" or $itemtype = "W" $altref = "" while true if $rollnr <> "BESPOK" messline(" Goods already received - no alterations allowed ",0,0,1,21,5,72) y2 = format("{D}elete reqn - {F10} to finish","M72") screen print 21 5 fgp bbd y2 return (0) end if x = entryline(" Enter Supplier's alteration reference - {Esc} if none ",20,"",$altref,21,5,72) screen clear box 22 1 22 scw 0 0 no-border if x = -1 messline(" Contact Supplier for reference first ",0,0,1,21,5,72) y2 = format("{D}elete reqn - {F10} to finish","M72") screen print 21 5 fgp bbd y2 return (0) end if $altref = ptstr $Emess = "Req'n deleted -"&prodcode&"- Supplier's new reference is"&$altref cat = "PUR_INVC" x = exception(userid,today,time24,cat,$Emess) DeletePurchord() vloadif(dpath|"cus_ent7.vw") WriteDelete() ' #recnr = record order change physical x = delidxrec("current.idx",#recnr,1) if records = 0 messbox(" No more to delete ",0,1,1) return (1) end if repaint off ' vloadif(dpath|"cus_ent7.vw") order change index "current.idx" return (0) end while elseif $itemtype = "O" $altref = "" while true while true x = entryline(" Reason for cancelling Override ",20,"",$altref,21,5,72) screen clear box 22 1 22 scw 0 0 no-border if x = -1 continue while end if exit while end while $altref = ptstr $Emess = "O'ride deleted -"&prodcode&"- reason is"&$altref cat = "PUR_INVC" x = exception(userid,today,time24,cat,$Emess) DeletePurchord() vloadif(dpath|"cus_ent7.vw") WriteDelete() ' #recnr = record order change physical x = delidxrec("current.idx",#recnr,1) if records = 0 messbox(" No more to delete ",0,1,1) return (1) end if repaint off ' vloadif(dpath|"cus_ent7.vw") order change index "current.idx" return (0) end while end if Title_B() END FUNCTION 'DeleteReqn() FUNCTION CheckFutureAppts() origview=apinfo(ap_filex) vloadif(dpath|"appntmnt.vws") ' message "jobnr is:"&str(jobnr) order change key "[Job_Nr]" data query execute "job_reqn.dfq" index "job_reqn.idx" ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ QUERY is: [Job_Nr] = jobnr ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if cerror vloadif(dpath|origview) return (1) end if data query execute "futurapp.dfq" index "appt.idx" ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' days([Date])>days(today) ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if cerror vloadif(dpath|origview) return (1) else messboxwait(" Delivery already booked - warn"&whseman&"to include new/altered req'n ",0,0,1) vloadif(dpath|origview) return (0) end if END FUNCTION ' CheckFutureAppts() FUNCTION ProcessTrade() local vardesc custref notif repaint off vloadif(dpath|"trade_1.vw") order change key "[Job_Nr]" data find "[Job_Nr]" equal jobnr options "gw" if cerror ' if none - then return messbox(" Job not found - no worksheet printed ",0,0,1) return (-1) else custname = [Customer_Name] deladdr1 = [Address_1] deladdr2 = [Address_2] deladdr3 = [City/Town] deladdr4 = [Postcode] faxnr = [Office_Fax] ' find req'ns (not deleted) for jobnr vloadif(dpath|"tradecnf.vw") order change key "[Job_Nr]" data query execute "job_reqn.dfq" index "trade_1.idx" ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' [Job_Nr] = jobnr ' and ' not(deleted) ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if cerror return (-1) end if ' calc var'n order value #var = filesum([InvValue]) varnr = jobnr|"-00" vardesc = "Items as per Confirmation Sheet" custref = "" notif = "Tradecnf" x = AddVarnTrade(varnr,#var,vardesc,custref,notif,today) ' sort by LstOrder vloadif(dpath|"tradecnf.vw") order sort execute dictionary "lst_stck" index "lst_stck" PrintReport("tradecnf.dfr","",p3,p4,p5,p6) return (0) end if END FUNCTION 'ProcessTrade() FUNCTION AddVarnTrade(varnr,#gross,$reas,$ref,$notif,$varndate) local balancedue lastbal newtotal oldtotal newnet oldnet #prec x #as #sr vloadif(dpath|"addvarn3.vw") data enter lock [Var_Nr] = varnr [VarnJobNr] = left(varnr,6) [Amount_Gross] = #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+vatrate),2) lock-record [Balance_Due] = balancedue [Invoice_Total] = newtotal [Net_Invoice] = newnet [Order_Status] = "P" write-record END FUNCTION ' AddVarnTrade() FUNCTION CheckPostcode() local ex #asc while true pc = [Postcode] ex=right(pc,4) if asc(left(ex,1))<>32 messbox(" Incomplete/incorrect postcode - update now? (y/n) ",1,1,1) if ptstr == "N" return (1) else x = fentrybox(" Customer's Postcode (NOT County!) ",8,"AU*7{[A-Za-z1234567890\ ]U}",pc) if x = 0 pc = ptstr lock-record [Postcode]=pc write-record continue while end if end if end if #asc = asc(right(ex,1)) if #asc > 90 or #asc < 65 'message "Not UPPER CASE letter" messboxwait(" Incomplete postcode ",0,0,1) return (1) end if #asc=asc(mid(ex,3,1)) if #asc > 90 or #asc < 65 'message "Not UPPER CASE letter" messboxwait(" Incomplete postcode ",0,0,1) return (1) end if exit while end while return (0) END FUNCTION 'CheckPostcode() FUNCTION ProcessChoice(typeidx) local origview2 bdb while true tempcode="N" clear prodMRC clear #unitcost clear $seltype clear $itemtype clear #ordwidth clear $backing clear desMRC clear $unit vloadif(dpath|"cus_ent4.vw") error off #refnr = filemax([#refnr]) 'message "#refnr) is:"&str(#refnr) if cerror #refnr = 0 end if refcode = jobnr|"-"|str(right("00"|str(#refnr+1),2))' clearvar() ' message "prodsel|$prodend is:"&str("prodsel"|$prodend) vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|typeidx if prodcode = "" if $prodend="B" y2 = format(" Scroll to find - F3 to search - Esc for Temporary Code ","M72") else y2 = format(" Scroll to find ","M72") end if screen print 21 5 fgp bbd y2 if $prodend = "A" bdb = bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0) else bdb = bpopdb("prodsel"|$prodend,4,"i","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) end if else data goto record record-number #prodrec if $prodend="B" y2 = format(" Scroll to find - F3 to search - Esc for Temporary Code ","M72") else y2 = format(" Scroll to find ","M72") end if screen print 21 5 fgp bbd y2 if $prodend = "A" bdb = bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0) else bdb = bpopdb("prodsel"|$prodend,4,"i","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) end if end if if bdb = -1 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) x=TempProductCode() if x = -1 AbandonEntry() exit while ' return (-1) end if 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 #prodrec = record if tempcode="N" $backing = [Backing] end if $uos = [Unit_Of_Sale] ' message "$uos is:"&str($uos) if $prodend ="B" if [Note]="Y" CheckSupplier() end if end if 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 ' new entry made vloadif(dpath|"cus_ent4.vw") order change index "current.idx" data goto record last Title_A() ' message "prodsel|$prodend is:"&str("prodsel"|$prodend) vloadif(dpath|"prodsel"|$prodend|".vw") continue while end if end while END FUNCTION ' ProcessChoice() FUNCTION BoxText(r1,c1,r2,c2,fg,bg,ts,jst,sprn,sml,pg) local wc p0 p1 p2 d dr dc a b c line1 lnmsg lmscn pt1 $line c3 local dlm rs ps ls fmt pcnt eot lts max q cr ls1 split #rem #rs split = 0 smartpeek $_l1 line1 max = 1000 if r2 > scrheight r2 = scrheight end if if c2 > scrwidth c2 = scrwidth end if dc = (c2 - c1) - 2 ' permitted line length dr = (r2 - r1) - 1 ts = wreplstr(ts,chr(126),chr(32)) ' replace ~/CR with space lts = len(ts) if lts = 0 return (-1) end if if dc<1 or dr<1 or dc>scrwidth or dr>scrheight or r1<1 or c1<1 return (-2) end if a = 0 eot = 0 wc = 2 dlm = chr(32) rs = ts redimension ptary[max] while a <= max a = a + 1 if len(rs) <= dc ' 145 ptary[a] = rs ' if whole message < box length exit while end if ls = left(rs,dc) ' 150 p1 = len(ls) q = ls if q ! chr(13) ' message "string with chr13 is:"&str(q) cr = find(chr(13),q,0) ' message "CR found at:"&str(cr) pt1 = left(q,cr) ReplaceHardSpace(pt1) ptary[a]=pt1 ' message "line upto CR is:"&str(ptary[a]) a = a + 1 ptary[a]=spc a = a + 1 #rs=len(rs) rs=right(rs,#rs-cr-1) ls = left(rs,dc) ' 150 end if for b = p1 to 0 step (-wc) ' search line from RHS for space to break if mid(ls,b,wc) ! dlm ' line at. p2 = find(dlm,mid(ls,b,wc),0) ' 155 ptary[a] = left(ls,(b+p2-1)) ls = mid(ls,b+p2) p0 = len(ls) for c = 1 to p0 if mid(ls,c,1) <> dlm exit for end if end for rs = mid(rs,(b+p2+c-1)) exit for end if end for if b <= 0 ' NO soft space ptary[a] = ls rs = mid(rs,p1+1) while left(rs,1) = dlm rs = mid(rs,2) end while end if end while if sprn = 1 fmt = (case lower(jst) ("r",jst)("m",jst) else "l")|str(dc) if sml = 1 if (r1+a) < r2 r2 = r1+a+1 dr = (r2 - r1) - 1 end if else if a < dr if (r1+a) < r2 for b = a+1 to dr ptary[b] = " " end for end if end if end if b = dr screen save r1 c1 r2+1 c2+1 psa 'NEW SCREEN SAVE r1+1 c1+1 r2+1 c2+1 $screen 'NEW _shade() 'NEW SCREEN SHORTRESTORE $screen 'NEW screen clear box r1 c1 r2 c2 fg bg c3=c2 screen print r1 c3 fg bg for pcnt = 1 to b $line = wreplstr(ptary[pcnt],chr(13),chr(32)) ' replace CR(music note) with space screen print (r1+pcnt) c1+2 fg bg format fmt $line end for screen save r1 c1 r2 c2 dsa redimension ptary[1] end if ptval = a return (0) END FUNCTION 'BoxText(r1,c1,r2,c2,fg,bg,ts,jst,sprn,sml,pg) FUNCTION wreplstr(s,f,r) local t l p t = s l = len(f) p = 0 while iserr(find(f,t,p)) = FALSE p = find(f,t,p) t = replace(t,find(f,t,p),l,r) end while return (t) END FUNCTION ' wreplstr(s,f,r) FUNCTION ReplaceHardSpace(str1) local j r m bw l_last #addn ' bw = 35 ' boxwidth bw = 52 ' 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 if len(m) < bw #addn = bw-len(m) else #addn = mod(len(m),bw) end if m = m|repeat("’",#addn) return (m) END FUNCTION ' ReplaceHardSpace() FUNCTION CheckSupplier() local z1 z2 z3 repaint off minord=[Min_Order] delchg=[Del_Charge] ornote=[OtherNotes] z1 = ReplaceHardSpace("Minimum order size/value:"¤cy(minord)) ' z2 = ReplaceHardSpace("Charge levied:’(exc VAT)’"¤cy(delchg)) ' if len(ornote)>0 z3 = ReplaceHardSpace(ornote) else z3 ="’" end if z = z1|z2|z3 if BoxText(2,13,6,67,10,5,z,"L",1,0,0) = 0 wait 2 screen shortrestore psa end if END FUNCTION ' CheckSupplier() FUNCTION CheckDelivered() ' check for amount scheduled but NOT delivered refcode = [Reference_Nr] origview=apinfo(ap_filex) 'message "origview is:"&str(origview) repaint off vloadif(dpath|"chckdeld.vw") order change key "[Requsn_Nr]" data query execute "chkdeld1.dfq" index "deld_1.idx" ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' [Requsn_Nr]=refcode ' and ' not (deleted) ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if cerror vunloadif("chckdeld.vw") vloadif(dpath|origview) return (0) end if if [CPL_Ref]<>blank vunloadif("chckdeld.vw") vloadif(dpath|origview) return (-1) else #dueout = round(filesum([QuantOut]),2) ' vunloadif("chckdeld.vw") vloadif(dpath|origview) return (#dueout) end if END FUNCTION 'CheckDelivered() FUNCTION ReAllocate() cdel = CheckDelivered() 'cdel = due out but NOT del'd if cdel > 0 messbox("’Delivered or scheduled for delivery; go to Diary to `un'deliver?(y/n) ",1,0,1) if ptstr == "y" Background() file unload all execute "alt_appt.rf3" in-memory end if return (1) elseif cdel = -1 messboxwait(" Cutting Ticket already printed - cannot reallocate ",0,0,1) return (1) end if execute "reqall_J.rf3" in-memory vloadif(dpath|"cus_ent7.vw") order change index "current.idx" return (0) END FUNCTION ' ReAllocate() FUNCTION ChkAllocations() vloadif(dpath|"cusent3b.vw") order change key "[Job_Nr]" data find "[Job_Nr]" equal jobnr options "" if cerror ' if none - then return x = messbox(" Job Nr not found - confirm as"&jobnr|"? (y/n) - {Esc} to exit ",1,0,0) end if if #reqnrecs > 0 error off while true messbox(" ALL details entered in FULL? (y/n) (No=more to enter later) ",1,1,1) if ptstr == "y" ' if left(jobnr,1)<>"T" messbox(" Print Worksheet for this job? (y/n) ",1,1,1) if ptstr == "y" PrintWorkSheet() end if vloadif(dpath|"cusent3b.vw") x = messbox(" Do you want to authorise this job? (y/n) ",1,1,1) if [OrderUpdated]<>"Y" 'check OrderUpdated = "Y" messboxwait(" Order details NOT yet entered - cannot process ",0,0,1) screen clear box 1 1 sch scw 0 0 no-border repaint off return (1) end if if ptstr == "y" ' case left(jobnr,1) ' when "T" ' when "P" ' otherwise ' x=CheckPostcode() ' if x = 1 ' Background() ' return (1) ' end if ' end case lock-record [Order_Status] = "U" write-record ' end if ' if left(jobnr,1)="T" ' ProcessTrade() ' end if exit while elseif ptstr == "n" ' not READY screen clear box 1 1 sch scw 0 0 no-border repaint off return (1) end if elseif ptstr == "n" ' not finished with job more reqns or screen clear box 1 1 sch scw 0 0 no-border repaint off return (1) end if end while end if Authorise() END FUNCTION ' ChkAllocations() FUNCTION ProcessRemnant() local DGnr prodcode="B/999999" ' prodMRC = "Remnant" $backing = "NONE" $itemtype = "B" x = messbox(" Does this piece have a Roll Nr in the form #####/## ? (y/n) ",1,1,1) if ptstr=="y" messboxwait(" This piece is listed under Stock Carpets - use F2 process ",0,0,1) return (-1) end if while true 'enter - DG nr ' x = entryline(" Enter DG Nr (numerical part only) ",3,"","",21,5,72) x = entryline(" Enter 'SH' Nr (numerical part only) ",4,"","",22,5,72) if len(ptstr)=1 DGnr="SH000"|ptstr elseif len(ptstr)=2 DGnr="SH00"|ptstr elseif len(ptstr)=3 DGnr="SH0"|ptstr elseif len(ptstr)=0 continue while else DGnr="SH"|ptstr end if x = messline(" Confirm"&DGnr|"? (y/n) ",1,1,1,22,5,70) if ptstr=="n" continue while else exit while end if end while while true 'enter - check nr x = entryline(" Enter Head Office check nr ",4,"*4#","",22,5,72) checknr = str(ptstr) x = messline(" Confirm check nr"&checknr|"? (y/n) ",1,1,1,22,5,70) if ptstr=="n" continue while else exit while end if end while while true 'enter - length x = entryline(" Enter LENGTH of remnant ",6,nr6,"",22,5,72) if x = 0 if value(ptstr) = 0 continue while else #ordlength = value(ptstr) x = messline(" Confirm length"&fixed(#ordlength,2)|"? (y/n) ",1,1,1,22,5,72) if ptstr=="n" continue while else exit while end if end if end if end while while true 'enter - width x = entryline(" Enter WIDTH of remnant ",6,nr6,"",22,5,72) if x = 0 if value(ptstr) = 0 continue while else #ordwidth = value(ptstr) x = messline(" Confirm width"&fixed(#ordwidth,2)|"? (y/n) ",1,1,1,22,5,72) if ptstr=="n" continue while else exit while end if end if end if end while while true 'enter - prodMRC entryline(" Enter Material description (from remnant list) ",25,"","",22,5,72) if ptstr = "" continue while else prodMRC = ptstr x = messline(" Confirm carpet is"&str(prodMRC)|"? (y/n) ",1,1,1,22,5,70) if ptstr=="n" continue while else prodMRC = str(right(DGnr,4))|"/"|prodMRC exit while end if end if end while while true 'enter - width entryline(" Enter Colour description (from remnant list) ",20,"","",22,5,72) if ptstr = "" continue while else desMRC = ptstr x = messline(" Confirm Colour is"&desMRC|"? (y/n) ",1,1,1,22,5,72) if ptstr=="n" continue while else exit while end if end if end while '? enter unit cost #unitcost = 0.01 #reqncost=value(#unitcost)*value(#ordwidth)*value(#ordlength) ' message "5889/#reqncost is:"&str(#reqncost) CreateStkBesp() END FUNCTION ' ProcessRemnant() FUNCTION CreateStkBesp() repaint off locn = "Nr19" $ccwcode = "" $auth = checknr vloadif(dpath|"stk_besp.vws") AllocateRollNr() ' generate unique Roll Nr #newliststck = 2 $stat = "I" ' message "#newliststck is:"&str(#newliststck) ' message "refcode is:"&str(refcode) ' message "prodcode is:"&str(prodcode) ' message "prodMRC is:"&str(prodMRC) ' message "desMRC is:"&str(desMRC) ' message "$itemtype is:"&str($itemtype) ' message "$stat is:"&str($stat) ' message "#ordlength is:"&str(#ordlength) ' message "#reqncost is:"&str(#reqncost) ' message "$auth is:"&str($auth) ' message "#ordwidth is:"&str(#ordwidth) ' message "userid is:"&str(userid) ' message "$ccwcode is:"&str($ccwcode) ' message "$rollnr is:"&str($rollnr) ' message "$backing is:"&str($backing) ' message "#prodrec is:"&str(#prodrec) 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 NewStockBespoke() ' create new record for STK_CARP/STK_BESP #ordlength = 0 exit while end while END FUNCTION ' CreateStkBesp() FUNCTION NewStockBespoke() vloadif(dpath|"stk_besp.vws") data enter lock [DateRecd] = today [Product_Code] = prodcode [Description_MRC] = desMRC [RollNr] = $rollnr [Width] = #ordwidth [Location] = locn [StockOrder] = refcode [Stock_Delivered] = #ordlength ' [Balance] = #ordlength [PhysicalBalance] = #ordlength ' [BAR] = #ordlength ' [Active] = "Y" [CCW_Code] = $ccwcode [Unit_Cost] = #unitcost [Comments] = checknr [Balance] = 0 [BAR] = 0 [Active] = "N" write-record END FUNCTION ' NewStockBespoke() FUNCTION AllocateRollNr() local datenumber datenumber = left(date2(today),2)|mid(date2(today),4,2) while true increment(dpath|"rollnr.dat",1) $rollnr = str(datenumber)|right(date2(today),1)|"/"|right("00"|str(ptval),2) order change key "[RollNr]" data find "[RollNr]" equal $rollnr options "" if cerror ' if none - then return exit while end if end while END FUNCTION ' AllocateRollNr() 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() x=EnterDetails() if x = -1 return (-1) end if END FUNCTION ' TempProductCode() 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 x=EnterSupplier() 'message "suppcode is:"&str(suppcode) if x = -1 return (-1) end if 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 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 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 TempCodeMultiCuts() local messq sr sc mbox c maxlen $len while true ' cycle thru to enter lengths x = fentrybox(" TOTAL nr of similar (other than length) requisitions",2,"*2{[1234567890]}","") if x = -1 return (-1) end if #nrrequsns = value(ptstr) ordref = "" specterm = "" #reqnlen = "" #totreqn = 0 for i = 1 to #nrrequsns $suffix = case i (1,"st")(2,"nd")(3,"rd") else "th" while true x = fentrybox(" Length of"&str(i)|$suffix&"requisition ",5,"*5{[1234567890.]}",#length) if x = 0 if value(ptstr) = 0 continue while elseif $itemtype = "S" #ordlength = value(ptstr) exit while elseif round(mod(value(ptstr)*100,5),0)=0 or round(mod(value(ptstr)*100,5),0)=5 ' #length = value(ptstr) ptstr = value(ptstr) #length = fixed(ptstr,2) screen clear box 22 1 22 scw 0 0 no-border exit while else ptstr = value(ptstr) x = round(ptstr*20,0)/20 #length = fixed(@if(xmaxlen maxlen=l end if end for sc=sc-maxlen-4 'message "sc is:"&str(sc) x = PopLengths(sr,sc,21,#reqnlen,"",1,0) ' show list screen shortrestore dsa $prevscn = psa messbox(str(#nrrequsns)&"cuts totalling"&fixed(#totreqn,2)|"m ("|fixed(#area,2)|"sqm)? (y/n) ",1,1,1) if ptstr == "y" screen shortrestore $prevscn repaint off exit while else screen shortrestore $prevscn #reqnlen = "" #totreqn = #length continue while end if end while ConfirmTempCodeMultiple_yn() END FUNCTION ' TempCodeMultiCuts() FUNCTION ConfirmTempCodeMultiple_yn() ' message "6521/ ConfirmTempCodeMultiple_yn()" $unit = [Unit_Desc] $uos = [Unit_Of_Sale] if $itemtype = "B" TempMultPurchOrderDetails() ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Calculate which Price to use - (SMLR - disc) at date of order ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ else 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 #newliststck = "1" ' $itemtype = "C" 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 order change index "current.idx" x = strtoary(#reqnlen) ' for i = 1 to #nrrequsns error off #refnr = filemax([#refnr]) 'message "#refnr is:"&str(#refnr) if cerror #refnr = 0 end if refcode = jobnr|"-"|str(right("00"|str(#refnr+1),2)) 'message "refcode is:"&str(refcode) $stat = "I" #ordlength = ptary[i] ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ 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 if $itemtype = "B" $rollnr = "BESPOK" else $rollnr = "00000/00" end if $auth = @if(priceauthority = blank,"None",priceauthority) ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Assign revised figures to REQUSN & PURCHORD ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if $itemtype = "B" vloadif(dpath|"cus_ent4.vw") WriteRecord() EnterTempMultPurchOrder() else Check_CCW() vloadif(dpath|"cus_ent4.vw") WriteRecord() end if vloadif(dpath|"cus_ent4.vw") end for END FUNCTION ' ConfirmTempCodeMultiple_yn() FUNCTION TempMultPurchOrderDetails() local mess oldstrt Background() purchorderdate = today 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 ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ 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 oldstrt = strtrow vloadif(dpath|"supplier.vws") suppname = filelookup([Supplier_Code],[Name],suppcode) vunloadif("supplier.vws") vloadif(dpath|"cus_ent4.vw") ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Enter comments & delivery address re Purchase ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if upd_new = "NEW" $comment = "None" end if x = colpopup(2,2,13,"Warehouse’ Branch To’Site Collect","Delivery",1,0,15,12,0,7) if ptstr = "Warehouse’" $del = "W" elseif ptstr = "Branch" screen shortrestore dsa x = colpopup(2,16,13,"Fulham Raynes Putney Sheen","Branch",1,0,10,13,0,7) $deladdr = ptstr $del = left(ptstr,1) elseif ptstr = "To’Site" $del = "S" while true screen shortrestore dsa x = entryline(" Site address/notes ",30,"","",21,5,72) if x = 0 if ptstr = "" continue while end if $deladdr = ptstr exit while end if end while elseif ptstr = "Collect" $del = "O" end if while true x = entryline(" Any comments on Purchase Order ",40,"",$comment,21,5,72) if x = 0 $comment = ptstr exit while end if end while screen clear box 22 5 22 77 0 0 no-border ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Supplier's reference ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ if upd_new = "NEW" ordref = "" while true x = entryline(" "|suppname|"'s reference ",20,"*20{XU}",ordref,21,5,72) if x = 0 ordref = ptstr if ordref = "" messline(" Must enter Supplier's reference! ",0,0,1,21,5,72) continue while else exit while end if end if end while else ordref = $altref end if screen clear box 22 5 22 77 0 0 no-border ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ ' ³ Ordered by? ³ ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ repaint off y2 = format(" Enter name of person ordering from Supplier ","M72") screen print 21 5 fgp bgp y2 OrderedBy() y2 = format(" ","M72") screen print 21 5 fgp bgp y2 ' x = messline("’TOTAL of"&fixed(#totreqn,2)&$unit&"ordered by"&orderby&"on"&purchorderdate&"? (y/n/Esc) ",1,0,0,21,5,72) x = messline("’TOTAL of"&fixed(#totreqn,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 END FUNCTION ' TempMultPurchOrderDetails() FUNCTION EnterTempMultPurchOrder() vloadif(dpath|"ent_pord.vw") data enter lock [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 ' EnterTempMultPurchOrder()