'ALT_APPT '[B1]="A" or [B1]="U" or [B1]="R" or [B1]="H" or [B1]="V" or [B1]="L" or [B1]="D" or [B1]="I" 'ALT_APPT - enter, update and cancel Fitting Appointments and Dates for ' selecting deliveries '02/07/97 - new version using Move Appts & Recalls '08/12/14 - revised to show Fitters only - Estimators now in Measures Diary external vloadif() dpath scr sch scw vunloadif() messboxwait() ipath bge X_path Background() external progress() fgp bgp messbox() cpath wraptext() fentrybox() shopmask external popuplist() strtoary() jobs[6] arytostr() fgs bgs messline() external userid fgi bgi base navrecs() bpopdb() entryline() chkdate() external addidxrec() delidxrec() remove() makeidx() getidxrecs() delstr() external strcount() colmessbox() $menu resref increment() external colpopup() _shade() flashmess() posncolpopup() areas _GEMS_Display_Message() external colpoplines() check_2000() PrintReport() _SWIP_Crystal() Xreppath public ptstr ptval ptary[1] $stock psa $ccwcode dsa $screen ftgdate custcode public #start #end #days plist[1,1] $cust $deldate reqnnr $thisday jobnr ml1 public $daynr $ftrcode $dateftr $user $ftrdate $dateout $reqnnr $GEMS_RADFuncTitle global x $rollnr ordref $dir #speed i $1stdate $lastdate #daysleft y4 y1 y2 y3 ViewMeasInfo() global #recs #days2tomorrow #int $gdsout1 $gdsout2 FindFirstJobNr() y5 y6 $measpcode custname $measaddr1 global prodcode $backing desMRC #ordwidth prodMRC $comment Recall() $text1 $measdesc $mustread $text2 $measinst global prodtype #nritems strtcol ReserveRecall() CancelRecall() #asc #unused CancelResvn() $popcol global $itemtype $ccwidx $refnr NavRecall() $ftr_ch $chckmeas #ordlen #lowerlen #upperlen #midlen $ccw global ftrlist[1,2] #rem #balance #minrsvn y strtrow $popstr z UnReserve() #delcost startdate enddate global col Reserve() BuildList() $list #oscost $loc $date $dow $dfa $name $a1 $a2 $a3 $a4 $a5 $a6 $a7 global Navigate() w $jobstr sd ViewInfo() Warranty() EnterCustName() NewGoodsOut() ftrname #appt $appth global deladdr1 $b1 $b2 $b3 $b4 $b5 $b6 $b7 ShowRecall() delcity BookAppt() delpostcode recallnr LookLeft() global abbrv_name title1 Show() n #prec #rec #count namelist[1,1] $idx drows pl t rec recs lc sc sym mr blen l c c2 r2 dc pc k pg tr global ReserveAppt() #del_cost #rem_len #refnr $ordstat #bline $instr refcode #rem_cost $ftgnr ShowDetails() MoveRight()spc $pl global regen() wreplstr() g fgc bgc CheckFree() CheckBooked() z1 z2 z3 z4 z5 z6 z7 z8 z9 ReplaceHardSpace() boxtext() $ftr wr global ReserveMenu() ApptReservn() BookReservn() s_reqpop ftrassist global FitterPopup() uistrcnt() udelstr() refresh() nr colSf colSb BookRecall() rb rescol #reslin S_instr MarkAbsent() global FindJobNr() PopJobs() $slotsrem #slotsrem #apptslots ShowMin() global NameAddressAsk() DeleteAppt() S_top S_RHS S_LHS Footer() WC() chkstr() $stat AlterApptSlots() ClearAppt() $dely $mess global NewDate() WriteApptDate() $col1 DrawLine() CheckDay() $status CheckLabour() Conv_Resvn() Conversion() CheckNr() SetupDetails() global ReturnToMenu() ApptsMenu() DeliverMenu() cr cf ts cb Setup() global SetupScreen() ss ChooseAction() CancelThisItem() AllThisReqn() global DeliverPart() #dellength #oslength AllUndeliveredReqns() Screen_1() global CancelAllThisday() ReservnBooking() ReplaceHardSpace2() res colIf colIb CancelAllGoodsOut() recval #needed Delypopup() linenr global #listcount poplist[1] $str_list #tline #lcol #split $selected AlterSlots_1() MarkDeliveries() $permit FindAppt() global ChooseFitter() ftrcode ChkDeliveries() Check4Appts() DaysLeft() global $location lr CheckOSDeliveries() MoveAppt() $movedely nrslots global Nav_Move() CheckNewPlace() DeliveriesOK() ShowMove() BookMove() global DeleteMoveFrom() AlterSlots_2() ShowFittings() resvdat clf clb ShowDeliveries() ShowFittings2() S_all #timeout global $dfa1 $ftrappts #ftrappts ftrarray[1] $day_1 $fitter bot jobdesc slotrec S_status ShowCustomer() #amount varndes global ftgcomm ftginstr ftgscrn $invoice $invnr $invdate $showdel ShowOrders() global custaddr1 custaddr2 custcity custpostcode deladdr2 #1stbalance global deladdr3 deladdr4 cust_title custcontact offtel hometel $partaddr global offax mobile custaddr deladdr Navreqns() NavMess() ShowReceipts() global ShowAllReqs() S_details ReqnLines() mess5 ShowInstructions() $chstr1 $chstr2 global EnterInstructions() WriteDetails() ChkAreas() CheckFtrProcessed() global cnp CheckNotProcessed() vo $docref chkdep FtrsWkSht() PrintJobSheet() global cr_status balancedue $ftrs #ftrs ShowFtrsWkSht() $dayftr $chstr ShowReturns() global p1 p2 p3 p4 p5 p6 CheckEstimator() MAIN single-step off ' message "AA L60 - ALT_APPT.RF3, 301615Z" screen clear box 1 1 sch scw 0 0 no-border quiet on repaint off file unload all progress(15,10," Loading files ... ",0) $permit = "TBELDI" bot = 7 clb = 13 #timeout = 60 clf = 10 chkdep=0 '1=check for 40% deposit - 0=don't check WC() Setup() x = Navigate() ReturnToMenu() END MAIN FUNCTION Setup() local cl1 cl2 r1 c1 r2 c2 vloadif(dpath|"apptdate.vws") order change key "[Date]" data find "[Date]" equal date2(days(today)+1) options "" if cerror data find "[Date]" equal date2(days(today)+2) options "" #recs = precord else #recs = precord end if vunloadif("apptdate.vws") error off ' colSf = 14 colSf = 15 ' colSb = 12 colSb = 1 colIf = 0 colIb = 15 repaint off vloadif(dpath|"shwappt3.vw") vloadif(dpath|"shwappt5.vw") DaysLeft() ' find nr of days left in APPTS file END FUNCTION 'Setup() FUNCTION ReturnToMenu() 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 CheckLabour() vloadif(dpath|"chk_labr.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 ",1,0,0) vunloadif("chk_labr.vw") return (-1) end if x=tablecount([Product_Code],[Item_Type]="F") if x = 0 ' if none - then return vunloadif("chk_labr.vw") return (-1) end if vunloadif("chk_labr.vw") return (0) END FUNCTION 'CheckLabour() FUNCTION Check4Appts() vloadif(dpath|"checkapp.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 ",1,0,0) vunloadif("checkapp.vw") return (-1) end if if [Appt_Slots] <= 0 'look for at least 1 appt slot vunloadif("checkapp.vw") return (1) end if return (0) END FUNCTION' Check4Appts() FUNCTION ShowDetails() local $chk $mess jobnr = "" $dfa=[DayFitter]|str(col-3) 'message "$dfa is:"&str($dfa) y=indirect("[A"|str(col-3)|"]") #asc=asc(right(y,1)) 'message "#asc is:"&str(#asc) if #asc > 57 or #asc < 48 'message "Not number" x=indirect("[B"|str(col-3)|"]") 'message "x) is:"&str(x) if indirect("[B"|str(col-3)|"]") <> "R" return (-1) ' NOT a job nr end if end if jobnr = indirect("[A"|str(col-3)|"]") 'message "jobnr) is:"&str(jobnr) $ordstat = indirect("[B"|str(col-3)|"]") 'message "AA L185 $ordstat is:"&str($ordstat) $chk = mid(jobnr,2,1) 'message "$chk is:"&str($chk) if chkstr($chk,"1 2 3 4 5 6 7 8 9 0") = 0 'messbox(" Not a Reservationÿ",0,1,1) ViewInfo() return (-1) else repaint off vloadif(dpath|"appntmnt.vws") $mess = filelookup([appntmnt.DFA],[appntmnt.DelAddr&Code],$dfa) $user = left($mess,6) $mess = right($mess,len($mess)-7) colmessbox(" Reserved for"&$mess|"ÿ",0,10,5,1) Show() return (1) end if ' if chkstr($chk,"1 2 3 4 5 6 7 8 9 0") = 0 'messbox(" Not a Reservationÿ",0,1,1) ' ' in SHWAPPT5.VW ' repaint off ' vloadif(dpath|"measure3.vw") ' custname=filelookup([measure3.Job_Nr],[measure3.CustOrd_Name],jobnr) ' message "name is:"&str(custname) ' $ordstat=filelookup([measure3.Job_Nr],[measure3.Order_Status],jobnr) ' message "ordstat is:"&str($ordstat) ' if $ordstat="M" ' $measinst=filelookup([measure3.Job_Nr],[measure3.Instructions],jobnr) ' message "$measinst) is:"&str($measinst) ' $measdesc=filelookup([measure3.Job_Nr],[measure3.Description],jobnr) ' message "$measdesc) is:"&str($measdesc) ' $mustread=filelookup([measure3.Job_Nr],[measure3.MustRead],jobnr) ' message "$mustread is:"&str($mustread) ' $measpcode=filelookup([measure3.Job_Nr],[measure3.MeasPostCode],jobnr) ' message "$measpcode) is:"&str($measpcode) ' $measaddr1=filelookup([measure3.Job_Nr],[measure3.MeasAddr1],jobnr) ' message "$measaddr1 is:"&str($measaddr1) ' $mobile=filelookup([measure3.Job_Nr],[measure3.Mobile],jobnr) ' message "L214 mobile is:"&str($mobile) ' if len($mobile)=0 ' $mobile="No Mobile" ' end if ' end if ' message "AA_O L214 mobile is:"&str($mobile) ' vunloadif("measure3.vw") ' vloadif(dpath|"shwappt5.vw") ' if $ordstat="M" ' ViewMeasInfo() ' else ' ViewInfo() ' end if ' return (-1) ' else ' repaint off ' vloadif(dpath|"appntmnt.vws") ' $mess = filelookup([appntmnt.DFA],[appntmnt.DelAddr&Code],$dfa) ' $user = left($mess,6) ' $mess = right($mess,len($mess)-7) ' colmessbox(" Reserved for"&$mess|"ÿ",0,10,5,1) ' Show() ' return (1) ' end if END FUNCTION 'ShowDetails() FUNCTION ReserveAppt() ' message "L197/ ReserveAppt()" $dfa = [DayFitter]|str(col-3) 'message "$dfa is:"&str($dfa) #appt = col - 3 ftrname = [Nickname] $ftrcode= right([DayFitter],6) 'message "$ftrcode) is:"&str($ftrcode) $dow = [DOW] if indirect("[A"|str(col-3)|"]") = "None" z = Reserve() '1=ALL ; 2=SOME ; 0=NONE resv'd '-1=Esc/NULL return if z = 1 ' ALL appts booked messbox(" ALL appointments booked!! ",0,1,1) return (1) elseif z = 0 ' NONE booked messboxwait(" NO appointments booked - cancelling GoodsOut records ",0,0,1) repaint off CancelAllGoodsOut() while true vloadif(dpath|"entappt4.vw") order change key "[Job_Nr]" data query execute "job_reqn.dfq" index "jobappt1.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Job_Nr] = jobnr ' and ' not(deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror return (0) end if data goto record first for i = 1 to records ' mark requsn's with ftgdate lock-record [Expect_Fitting_Date] = blank [Ftr_Code] = "" write-record data goto record next end for exit while end while vunloadif("entappt4.vw") return (0) ' Show() elseif z = 2 ' SOME booked messboxwait(" Not All appointments are booked! ",0,0,1) messbox(" Alter number of appointments? (y/n) ",1,1,1) if ptstr == "y" AlterApptSlots() return (2) ' Show() else messboxwait(" Book remaining appointments!! ",0,0,1) return (-1) end if elseif z = -1 ' NULL return return (-1) end if else ' jobnr <> "None" return (-1) end if END FUNCTION 'ReserveAppt() FUNCTION ClearAppt() $dfa = [DayFitter]|str(col-3) 'message "$dfa is:"&str($dfa) y=indirect("[A"|str(col-3)|"]") #asc=asc(right(y,1)) 'message "#asc is:"&str(#asc) if #asc > 57 or #asc < 48 'message "Not number" return (-1) 'NOT a job nr end if jobnr = indirect("[A"|str(col-3)|"]")' #appt = col - 3 ftrname = [Nickname] $dow = [DOW] if $menu = "offc" or $menu = "shop" ' resvdat = left(jobnr,1) x = ChkAreas(resvdat,areas) 'message "x is:"&str(x) if x = -1 '0=found in string; -1= NOT found messbox(" You can only cancel your own shop's app'ts! Contact HO (ref 1) ",0,0,1) return (-1) end if end if z = UnReserve() '1=ALL ; 2=SOME ; 0=NONE resv'd ' '-1=Esc/NULL return ' find if any appt for THIS job on THIS day ' message "Check for any deliveries on this day if no appts" ' w = CheckDay() ' 0=Appt STILL booked; 1=NONE booked ' if w = 1 ' NO bookings left for this job ' repaint off ' cag = CancelAllGoodsOut() vloadif(dpath|"shwappt5.vw") if z = 1 ' ALL appts booked messboxwait(" ALL appointments booked!! ",0,1,1) Show() elseif z = 0 ' NONE booked messboxwait(" NO appointments booked ",0,0,1) CancelAllGoodsOut() Show() elseif z = 2 ' SOME booked messboxwait(" Not All appointments are booked! ",0,0,1) messbox(" Alter number of appointments? (y/n) ",1,1,1) if ptstr == "y" AlterApptSlots() Show() else messboxwait(" Book remaining appointments!! ",0,0,1) return (-1) end if elseif z = -1 ' NULL return return (-1) end if END FUNCTION 'ClearAppt() FUNCTION CheckDay() local i $a for i=1 to 7 let $a=indirect("[A"|str(i)|"]") if $a = jobnr return (0) end if end for return (1) END FUNCTION 'CheckDay() FUNCTION ShowMin() ' y1 = format("{A}pp'ts {D}etails {F}ind appt {O}rderStatus Deli{V}eries {M}easuring {Esc}ÿ","M80") ' screen print 29 16 fgp bgp y1 y2 = format(" Reservationÿ","M14") screen print 30 16 14 7 y2 y3 = format(" Not ready for delivery ","M24") screen print 30 30 4 7 y3 y4 = format(" Ready for delivery ","M20") screen print 30 54 10 7 y4 y5 = format("ÿWarrantyÿ","M10") screen print 30 74 13 7 y5 y6 = format(" Assisting ","M12") screen print 30 84 11 7 y6 ' y2 = format("ÿ Reservationÿ","M17") ' screen print 22 1 14 7 y2 ' y3 = format(" Not ready for delivery ","M28") ' screen print 22 17 4 7 y3 ' y4 = format(" Ready for delivery ","M24") ' screen print 22 44 10 7 y4 ' y5 = format("ÿWarrantyÿ","M13") ' screen print 22 67 13 7 y5 ' y6 = format("ÿAssisting ","M15") ' screen print 22 79 11 7 y6 END FUNCTION ' ShowMin() FUNCTION Reserve() '1=ALL ; 2=SOME ; 0=NONE resv'd; -1=Esc/NULL return local ba ' $dow = [DOW] ' message "AA L393 $dow) is:"&str($dow) repaint off ' message "L348/ Reserve()" x = FindJobNr(0) ' Line 741 if x = -1 return (-1) 'Esc/NULL return elseif x = 1 return (-1) 'Esc/NULL return end if if #slotsrem = 0 messbox(" No more appointments to book ",0,0,1) return (-1) 'NULL return end if if Check4Appts() = 1 ' NULL return x = messboxwait(" No Appointment slots entered - enter these first ",0,0,1) return (-1) end if vloadif(dpath|"shwappt5.vw") while true if indirect("[A"|str(col-3)|"]") = "None" $dfa=[DayFitter]|str(col-3) ' $appth = case #appt (1,"1st")(2,"2nd")(3,"3rd") else str(#appt)|"th" y1=format("Now booking appt's for"&"-"&title1,"M110") screen print 1 1 fgp bgp y1 ' x=messbox(" Book as"&ftrname|"'s"&$appth&"app't on"&upper(left(date1(ftgdate),6))|"? Y/N ("|str(#slotsrem)&"slots remaining) ",1,1,1) $dow=upper(left(dayname(ftgdate),3)) x=messbox(" Book as"&ftrname|"'s"&$appth&"app't on"&$dow&upper(left(date1(ftgdate),6))|"? Y/N ("|str(#slotsrem)&"slots remaining) ",1,1,1) if ptstr == "Y" ' Book appt ba=BookAppt() 'message "1=Booked; 0=Not booked:"&str(ba) if ba = 0 ' Appt NOT booked repaint on repaint if #slotsrem = 0 return (1) ' ALL booked end if elseif ba = 1 ' Appt BOOKED if #slotsrem = 0 return (1) ' ALL booked end if MoveRight() repaint on repaint continue while end if else ' DO NOT book appt repaint on repaint if #slotsrem = 0 return (1) ' ALL booked elseif #slotsrem = #apptslots return (0) ' NONE booked else return (2) ' SOME booked end if end if else 'message "col is:"&str(col) if col = 10 return (-1) 'Null return else messbox(" Appointment already booked ",0,0,1) return (-1) 'Null return end if end if end while END FUNCTION ' Reserve() FUNCTION UnReserve() local cod cag $dateout=[Date] 'message "$dateout is:"&str($dateout) while true if indirect("[A"|str(col-3)|"]") <> jobnr return (-1) end if repaint off vloadif(dpath|"find_job.vw") order change key "[Job_Nr]" data find "[Job_Nr]" equal jobnr options "g" ' find correct JOB if cerror messbox(" Job Nr NOT found ",0,0,1) ' Show() ' return (-1) end if #slotsrem = value([Slots_Rem]) #apptslots = value([Appt_Slots]) if #apptslots = 1 if #slotsrem = 0 ' AllBooked() y3 = format("One appointment - already booked","M80") else y3 = format(str(#apptslots)&"appointment to book -"&str(#slotsrem)&"unbooked","M80") end if else if #slotsrem = 0 ' AllBooked() $slotsrem = "NONE" else $slotsrem = str(#slotsrem) end if y3 = format("Total of"&str(#apptslots)&"appointments to book -"&$slotsrem&"unbooked","M80") end if screen print 22 1 15 12 y3 $appth = case #appt (1,"1st")(2,"2nd")(3,"3rd") else str(#appt)|"th" x = messline(" Cancel"&jobnr&"as"&ftrname|"'s"&$appth&"appointment on"&$dow&date2(ftgdate)|"? (y/n) ",1,1,1,21,1,80) if ptstr == "Y" ' message "ftgdate is:"&date2(ftgdate) cnp=CheckNotProcessed() ' message "cnp is:"&str(cnp) if cnp = 2 ' some fitting costs already processed messboxwait(" Fittings already processed - cannot remove ",0,0,1) ' Show() return (-1) end if cod=CheckOSDeliveries() ' message "cod is:"&str(cod) if cod = 2 'only appt for day; o/s deliveries to remove messbox(" Last appt for this day - continue & remove deliveries? (y/n) ",1,0,1) if ptstr == "y" cag=CancelAllGoodsOut() 'message "cag) is:"&str(cag) else vloadif(dpath|"shwappt5.vw") if #slotsrem = 0 return (1) 'ALL booked elseif #slotsrem = #apptslots return (0) 'NONE booked else return (2) 'SOME booked end if end if end if vloadif(dpath|"find_job.vw") x = DeleteAppt() '1=deleted; 0=NOT deleted; 2=ALL deleted if x = 0 ' NOT deleted repaint on repaint if #slotsrem = 0 return (1) ' ALL booked end if elseif x = 2 ' ALL DELETED return (0) elseif x = 1 ' Appt DELETED Show() continue while end if else ' NOT cancelled vloadif(dpath|"shwappt5.vw") if #slotsrem = 0 ' AllBooked() return (1) 'ALL booked elseif #slotsrem = #apptslots return (0) 'NONE booked else return (2) 'SOME booked end if end if end while END FUNCTION 'UnReserve() FUNCTION CheckNotProcessed() ' look up GOODSOUT to check whether the appropriate record has been [Docref]'d ' in FIND_JOB.VW vloadif(dpath|"chkntprc.vw") ' vloadif(dpath|"goodsout.vws") ' message "L514/ GOODSOUT file checked" data query execute "chkntprc.dfq" index "chkntpro.idx" ' find all records with same jobnr & ftgdate ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' days([Date_Out])=days($dateout) ' and ' [Itemtype] ' and ' [Job_Nr]=jobnr ' and ' not (deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror messboxwait(" NO appointments booked ",0,0,1) order change physical ' vloadif(dpath|"chkntprc.vw") ' vunloadif("goodsout.vws") return (1) else for i = 1 to records if [Document]<>blank 'message "Already processed" ' vloadif(dpath|"chkntprc.vw") ' vunloadif("goodsout.vws") ' return (2) ' some processed messboxwait([Description_MRC]&"already processed ",0,0,1) end if data goto record next end for return (2) ' some processed end if END FUNCTION ' CheckNotProcessed() FUNCTION DeleteAppt() local nextnr repaint off vloadif(dpath|"bookappt.vw") if lr=0 order change key "[DFA]" data find "[DFA]" equal $dfa options "F" if cerror ' if none - then return x = messbox(" Job Nr not found ",1,0,0) return (0) end if lr=1 elseif lr=1 data goto record next nextnr = [Job_Nr] if nextnr <> jobnr return (2) ' NONE booked/ALL appts deleted end if end if lock-record [Job_Nr] = "None" [DelAddr&Code] = "" [Entered_By] = userid [Date_Altered] = today [Time] = now [N_name] = "" [Status] = "" write-record repaint off vloadif(dpath|"shwappt5.vw") lock-record dbput("[A"|str(col-3)|"]","None") dbput("[B"|str(col-3)|"]","") write-record #slotsrem = #slotsrem + 1 repaint off vloadif(dpath|"find_job.vw") lock-record ' update CUST_ORD record [Slots_Rem] = #slotsrem write-record repaint off vloadif(dpath|"shwappt5.vw") if #slotsrem = #apptslots ' NONE booked/ALL appts deleted repaint off vloadif(dpath|"find_job.vw") lock-record ' update CUST_ORD record [Fitting_Date] = blank [Ftr_Code] = "" write-record return (2) end if if #appt < 7 #appt = #appt + 1 if col = 10 ' check that cursor does not go to col 11 beep return (1) end if col = col + 1 suspendone keys Right,F8 else ' message "Some ftgs remaining??" return (1) end if ' message "lr is:"&str(lr) return (1) END FUNCTION ' DeleteAppt() FUNCTION BookAppt() x = LookLeft(jobnr) if x = 0 'message "Cell to left is same jobnr" $ordstat = "C" else $ordstat = "P" end if repaint off vloadif(dpath|"bookappt.vw") order change key "[DFA]" data find "[DFA]" equal $dfa options "" if cerror ' if none - then return x = messbox(" $dfa not found ",0,0,1) Show() return (0) ' NOT booked end if lock-record ' Book appt on screen [Job_Nr] = jobnr ' [DelAddr&Code] = left(deladdr1|","&delpostcode,30) [Entered_By] = userid [Date_Altered] = today [Time] = now [N_name] = ftrname [Status] = $ordstat [Date_Code] = str(date2([Date])&[Fitter_Code]) write-record #slotsrem = #slotsrem - 1 repaint off vloadif(dpath|"find_job.vw") lock-record ' update CUST_ORD record [Slots_Rem] = #slotsrem if [Fitting_Date]=blank [Fitting_Date] = ftgdate [Ftr_Code] = $ftrcode end if write-record repaint off vloadif(dpath|"shwappt5.vw") lock-record dbput("[A"|str(col-3)|"]",jobnr) dbput("[B"|str(col-3)|"]",$ordstat) write-record return (1) END FUNCTION ' BookAppt() FUNCTION PopJobs() local ljob ljobmax ls c1 c2 c3 mess1 mess2 ljob = 0 ljobmax = 0 for i = 1 to 6 ljob = len(group($jobstr,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 x = colpopup(8,c1,15,$jobstr,"",1,0,colSf,colSb,colIf,colIb) if x = 0 jobnr = left(ptstr,6) vloadif(dpath|"find_job.vw") error off z1 = filelookup([find_job.Job_Nr],[find_job.CustOrd_Name],jobnr) z2 = filelookup([find_job.Job_Nr],[find_job.Delivery_Address_1],jobnr) title1 = left(z1|","&z2,30)&"("|jobnr|")" return (0) elseif x = -1 jobnr = "" return (-1) end if END FUNCTION 'PopJobs() FUNCTION AddToArray() local $new $newcust $hold h y = strtoary(custname) $newcust = "" for i = 1 to ptval if i = 1 $newcust = ptary[i] ' NB - space is Alt-255 else $newcust = $newcust|"ÿ"|ptary[i] ' NB - space is Alt-255 end if end for $new = jobnr|"ÿ"|$newcust ' HARD space for i = 1 to 6 if left(jobs[i],6) = jobnr ' jobnr already held $hold = jobs[i] for h = i-1 to 1 step -1 if len(jobs[h]) = 0 jobs[h+1] = "" else jobs[h+1] = jobs[h] end if end for jobs[1] = $hold return (0) end if end for for i = 5 to 1 step -1 if len(jobs[i]) = 0 jobs[i+1] = "" else jobs[i+1] = jobs[i] end if end for redimension ptary[6] jobs[1] = $new for i = 1 to 6 ptary[i] = jobs[i] end for END FUNCTION ' AddToArray() FUNCTION FindJobNr(n) ' finds Job & updates Cust_Ord local l1 c3 c2 c1 ques $reqstr fj a if n = 0 redimension ptary[6] for i = 1 to 6 ptary[i] = jobs[i] end for x = arytostr(6) $jobstr = ptstr ' message "$jobstr) is:"&str($jobstr) fj = PopJobs() smartpoke $_ins 0 else fj = -1 end if while true if fj = -1 ' x = EnterCustName() x = CheckNr() if x = -1 return (-1) ' ReturnToMenu end if end if repaint off vloadif(dpath|"find_job.vw") order change key "[Job_Nr]" data find "[Job_Nr]" equal jobnr options "g" ' find correct JOB if cerror 'message "jobnr is:"&str(jobnr) messbox(" Job Nr NOT found ",0,0,1) return (1) end if ' message "L772/ " if chkdep=1 ' if switched on then check 40% deposit has been rec'd ' a=[Credit_Status] ' message "Order Status is:"&str(a) if [Credit_Status]<>"A" if [Balance_Due]>([Invoice_Total]*.6) messboxwait("(L779) Cannot book appointment - deposit received less than 40% ",0,0,1) return (1) end if end if end if #slotsrem = [Slots_Rem] #apptslots = [Appt_Slots] custname = [CustOrd_Name] deladdr1 = [Delivery_Address_1] delcity = [Del_City] delpostcode = [Del_Postcode] $ordstat = [Order_Status] 'message "$ordstat is:"&str($ordstat) title1 = left(custname|","&deladdr1,30)&"("|jobnr|")" ' if $ordstat = "D" ' already despatched ' messboxwait(" Order already completed ",0,0,1) ' return (-1) ' ReturnToMenu ' elseif $ordstat <> "P" ' if $ordstat <> "I" ' must be PASSED or INCOMPLETE ' messboxwait(" This order has not yet been authorised by Head Office ",0,0,1) ' else ' messboxwait(" This order has not yet been authorised by Head Office ",0,0,1) ' end if ' end if case $ordstat when "D" messboxwait(" Order already completed ",0,0,1) AddToArray() return (1) when "C" messboxwait(" Recall Needed ",0,0,1) AddToArray() return (1) when "H" messboxwait(" Order referred to DG ",0,0,1) AddToArray() return (1) when "V" messboxwait(" Order rejected for further details/requsn's ",0,0,1) AddToArray() return (1) when "P" ' Authorised and ready to book Fitting appt's AddToArray() return (0) when "U" ' updated and can be booked if there are Appt Slots AddToArray() return (0) otherwise messboxwait(" Shop to enter customer details ",0,0,1) AddToArray() return (1) end case repaint off return (0) end while END FUNCTION ' FindJobNr() FUNCTION ViewInfo() local spc2 a1 a2 spc2 = "ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ" ' ALT-255 spaces spc = "ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ" ' ALT-255 spaces $pl = "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÿ" $cust = filelookup([shwappt3.Job_Nr],[shwappt3.Customer_Code],jobnr) z1 = filelookup([shwappt3.Job_Nr],[shwappt3.CustOrd_Name],jobnr) z1 = ReplaceHardSpace(z1) z2 = filelookup([shwappt3.Job_Nr],[shwappt3.Delivery_Address_1],jobnr) z2 = ReplaceHardSpace(z2) z3 = filelookup([shwappt3.Job_Nr],[shwappt3.Del_City],jobnr) z6 = filelookup([shwappt3.Customer_Code],[shwappt3.Home_Tel],$cust) z7 = filelookup([shwappt3.Customer_Code],[shwappt3.Office_Tel],$cust) z4 = filelookup([shwappt3.Job_Nr],[shwappt3.Description],jobnr) a1 = filelookup([shwappt3.Job_Nr],[shwappt3.Appt_Slots],jobnr) a2 = filelookup([shwappt3.Job_Nr],[shwappt3.Slots_Rem],jobnr) if left(right(z4,2),1)<>";" z4 = z4|";ÿ" end if z5 = filelookup([shwappt3.Job_Nr],[shwappt3.Instructions],jobnr) if len(z4)=0 z4 = "ÿÿ" end if if len(z5)=0 z5 = "ÿÿ" end if z8 = format(z3,"L20")|"ÿH"|format(z6,"L15")|"ÿW"|format(z7,"L15") z8 = ReplaceHardSpace(z8) z9 = left("Appt slots"&str(a1)&"(unbooked"&str(a2)|")"|spc,54) z9 = ReplaceHardSpace(z9) z = z1|z2|z8|z9|$pl|z4|chr(13)|z5 if BoxText(4,13,17,68,10,5,z,"L",1,0,0,$ordstat) = 0 wait 7 screen shortrestore psa end if END FUNCTION 'ViewInfo() FUNCTION ViewMeasInfo() $GEMS_RADFuncTitle=$measpcode&"-"&custname|","&$measaddr1 ' &"-"&upper($mustread) ' message "$GEMS_RADFuncTitle) is:"&str($GEMS_RADFuncTitle) $text1=$measdesc&"-"&upper($mustread) $text2=$measinst #unused="" _GEMS_Display_Message($text1,$text2,#unused) $GEMS_RADFuncTitle="" END FUNCTION 'ViewMeasInfo() FUNCTION BoxText(r1,c1,r2,c2,fg,bg,ts,jst,sprn,sml,pg,sm) 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 SCREEN SHORTRESTORE $screen 'NEW sm = case sm ("A","ÿINITIALÿORDERÿ")("U","ÿUPDATEDÿORDERÿ")\ ("R","ÿAWAITING AUTHOR'Nÿ")("H","ÿHELDÿ")("V","ÿSHOP TO REVIEWÿ")\ ("P","ÿAUTHORISED FOR FITTINGÿ")("L","ÿBEING PREPARED FOR DELIVERYÿ")\ ("D","ÿCOMPLETEDÿ")("I","ÿDELIVERIES O/Sÿ")("C","ÿRECALLSÿ") else "ÿNot knownÿ" screen clear box r1 c1 r2 c2 fg bg c3=c2-len(sm) screen print r1 c3 fg bg sm for pcnt = 1 to b ' message "$line is:"&str($line) $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 FUNCTION ReplaceHardSpace(str1) local j r m bw l_last #addn ' bw = 35 ' boxwidth ' bw = 43 ' boxwidth bw = 54 ' 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 Absent(ms,st) repaint off jobnr = ms vloadif(dpath|"shwappt5.vw") repaint on repaint while true if indirect("[A"|str(col-3)|"]") = "None" $dfa = [DayFitter]|str(col-3) messbox(" Allocate this appt? (y/n) ",1,1,1) if ptstr == "y" while true x = entryline(" Reason for absence ",30,"","",22,1,80) if x = -1 return (-1) end if $comment = ptstr exit while end while x=MarkAbsent(ms,st) if x = 0 repaint on repaint if col = 10 ' check that cursor does not go to col 11 return (1) end if col=col + 1 suspendone keys Right,F8 end if else return (1) end if else messbox(" Appointment already booked ",0,0,1) return (1) end if end while END FUNCTION ' Absent() FUNCTION ReInstate() repaint off vloadif(dpath|"shwappt5.vw") repaint on repaint if indirect("[B"|str(col-3)|"]") = "A" $dfa = [DayFitter]|str(col-3) x = MarkAbsent("None","") if x = 0 repaint on repaint end if else messbox(" Appointment already booked ",0,0,1) end if END FUNCTION ' ReInstate() FUNCTION MarkAbsent(ms1,st) repaint off vloadif(dpath|"bookappt.vw") order change key "[DFA]" data find "[DFA]" equal $dfa options "" if cerror ' if none - then return return (0) end if lock-record [Job_Nr] = ms1 [DelAddr&Code] = $comment [Entered_By] = userid [Date_Altered] = today [Time] = now [N_name] = ftrname [Status] = st write-record vloadif(dpath|"shwappt5.vw") lock-record dbput("[A"|str(col-3)|"]",ms1) dbput("[B"|str(col-3)|"]",st) write-record if #appt < 7 #appt = #appt + 1 if col = 10 ' check that cursor does not go to col 11 beep return (0) end if col=col+1 suspendone keys Right,F8 else return (0) end if return (1) END FUNCTION ' MarkAbsent() FUNCTION NameAddressAsk(msg1,msg2) local fc2 bc2 fc1 bc1 r1 r2 c1 c2 c3 lmsg mbox k err q cc endmess f1 q = 1 err = 0 endmess = " Correct? (y/n) " k=0 fc1=fgp bc1=bgp fc2=fgi bc2=bgi mbox = scrwidth lmsg=max(len(msg1),len(msg2),len(endmess)+2) 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 cc = scrwidth/2-(len(endmess)/2)+1 screen save r1 c1 r2 c2 psa screen clear box r1 c1 r2 c2 fc1 bc1 screen print scr-1 c3 fgp bgp FORMAT "M"|str(lmsg) msg1 screen print scr c3 fgp bgp FORMAT "M"|str(lmsg) msg2 screen print scr+1 cc fc2 bc2 endmess screen save r1 c1 r2 c2 dsa while "yn" !! k locate scr+1 (cc+len(endmess)-1) 1 k=inchar k = lower(chr(k)) end while locate scr (c3+lmsg) 0 screen shortrestore psa if k = 0 ptstr = NULL else ptstr = k end if return (err) END FUNCTION' NameAddressAsk() FUNCTION EnterCustName() vloadif(dpath|"custsel6.vw") if base = "O" or base = "W" order change index ipath|"cust_ord.idx" else order change index ipath|base|"_orders.idx" end if x = entryline(" Enter 1st SEVEN letters of name ",7,"","",22,1,80) abbrv_name = ptstr ' screen clear box 22 1 sch scw 0 0 no-border progress(15,10," Finding customer list ... ",0) x = bpopdb("custsel6",5,"fi"&abbrv_name,"[Name]","L37","[Abbrv_Name]","L7","[Job_Nr]",3,42,14,80,"",0) if x = -1 return(-1) else jobnr = ptstr 'message "ptstr) is:"&str(ptstr) title1 = [Name] return(1) end if END FUNCTION 'EnterCustName() FUNCTION chkstr(s,sl) local t i i=0 while exact(t,NULL)=FALSE i=i+1 t = group(sl,i) if t = s return (0) end if end while return (-1) end function 'chkstr() FUNCTION NewDate() local datecode newdate daytitle #appts $daynr lday ' find latest date of appts in file lday = filemax([Date]) 'message "lday is:"&date2(lday) x = ChooseFitter() if x = -1 return(-1) end if 'choose date while true x = fentrybox(" Enter Date of Appointment ",10,"##\/##\/####",date2(lday)) if x = 0 newdate = ptstr if chkdate(newdate,1) = -1 messbox(" Incorrect date - re-enter ",0,0,1) continue while end if else Show() return (-1) end if if days(newdate)-days(today) > 90 messbox(" Cannot book more than 90 days in advance - re-enter ",0,0,1) continue while end if exit while end while 'create records in APPNTMNT.VWS vloadif(dpath|"shwappt3.vw") $daynr = str(days(newdate)) 'message "1303\ $daynr is:"&str($daynr) $dfa = $daynr|ftrcode|str(1) 'message "$dfa is:"&str($dfa) data find "[DFA]" equal $dfa options "g" if cerror daytitle = "None" vloadif(dpath|"creatapp.vw") for #appts = 1 to 7 ' for each appt continue creating $dfa = $daynr|ftrcode|str(#appts)'message "$dfa is:"&str($dfa) data enter lock [Fitter_Code] = ftrcode [Date] = newdate [Day_Nr] = $daynr [DFA] = $dfa [Job_Nr] = daytitle [Appointment_Order] = str(#appts) [Date_Code] = str(date2(newdate)&ftrcode) write-record end for else ' message "1321\ ftrname is:"&str(ftrname) messbox(" Appointments already exist for"&ftrname&"on this Date ",0,0,1) Show() return (-1) end if $date = newdate $dow = left(dayname(newdate),3) $dfa = left($dfa,11) ' $name = ftrname $name = ftrassist $a1 = daytitle $a2 = daytitle $a3 = daytitle $a4 = daytitle $a5 = daytitle $a6 = daytitle $a7 = daytitle DrawLine() $a1 = daytitle WriteApptDate() vloadif(dpath|"shwappt5.vw") repaint on repaint END FUNCTION ' NewDate() FUNCTION WriteApptDate() local $shwdate $shwdate = left(date1($date),6) ' message "$name) is:"&str($name) ' message "$a1) is:"&str($a1) ' message "$a2) is:"&str($a2) ' message "$a3) is:"&str($a3) ' message "$a4) is:"&str($a4) ' message "$a5) is:"&str($a5) ' message "$a6) is:"&str($a6) ' message "$a7) is:"&str($a7) ' message "$b1) is:"&str($b1) ' message "$b2) is:"&str($b2) ' message "$b3) is:"&str($b3) ' message "$b4) is:"&str($b4) ' message "$b5 is:"&str($b5) ' message "$b6 is:"&str($b6) ' message "$b7 is:"&str($b7) ' message "$location is:"&str($location) ' message "$shwdate is:"&str($shwdate) vloadif(dpath|"apptdate.vws") data enter lock [Date] = $date [Shw_Date] = $shwdate [DOW] = $dow [DayFitter]= $dfa [Nickname] = $name [A1] = $a1 [A2] = $a2 [A3] = $a3 [A4] = $a4 [A5] = $a5 [A6] = $a6 [A7] = $a7 [B1] = $b1 [B2] = $b2 [B3] = $b3 [B4] = $b4 [B5] = $b5 [B6] = $b6 [B7] = $b7 [Location] = $location write-record vloadif(dpath|"shwappt4.vw") END FUNCTION 'WriteApptDate() FUNCTION DrawLine() vloadif(dpath|"apptdate.vws") $a1 = "ÛÛÛÛÛÛÛÛ" $b1 = "A" data enter lock [Date] = blank [DOW] = blank [DayFitter]= blank [Nickname] = blank [A1] = $a1 [A2] = $a1 [A3] = $a1 [A4] = $a1 [A5] = $a1 [A6] = $a1 [A7] = $a1 [B1] = $b1 [B2] = $b1 [B3] = $b1 [B4] = $b1 [B5] = $b1 [B6] = $b1 [B7] = $b1 write-record vloadif(dpath|"shwappt4.vw") END FUNCTION ' DrawLine() FUNCTION AlterApptSlots() local #newapptslots #newslotsrem #newapptslots = #apptslots - #slotsrem while true x = fentrybox(" Revised Nr of Appt slots ",2,"",#newapptslots) if x = -1 messbox(" Leave appointment slots at"&str(#apptslots)|"? (y/n) ",1,1,1) if ptstr == "Y" exit while else continue while end if end if if len(ptstr) = 0 continue while end if #newapptslots = value(ptstr) messbox(" Confirm revised appointment slots of"&str(#newapptslots)|"? (y/n) ",1,1,1) if ptstr == "Y" exit while else continue while end if end while ' write to CUST_ORD #newslotsrem = #slotsrem + (#newapptslots-#apptslots) vloadif(dpath|"find_job.vw") order change key "[Job_Nr]" data find "[Job_Nr]" equal jobnr options "g" ' find correct JOB if cerror messbox(" Job Nr NOT found ",0,0,1) ' Show() return (-1) end if lock-record [Slots_Rem] = #newslotsrem [Appt_Slots] = #newapptslots write-record return (0) END FUNCTION ' AlterApptSlots() FUNCTION Footer() screen clear box 21 1 sch scw 0 0 no-border screen print #bline+1 1 15 1 (format("{D}eliver on"&date2(ftgdate)&"- {C}ancel delivery","M80")) if sd = 1 screen print #bline+2 1 15 1 (format("{S}plit del'y {F10}=finish {Esc}=exit","M80")) else screen print #bline+2 1 15 1 (format("{S}plit del'y {A}LL reqn's {F10}=finish {Esc}=exit","M80")) end if screen print #bline+3 1 15 1 (format("","M80")) screen print #bline+3 3 10 1 (format("Reserved/Initial","M20")) screen print #bline+3 24 15 1 (format("Allocated/Received","M20")) screen print #bline+3 44 12 1 (format("HELD","M10")) screen print #bline+3 55 7 1 (format("Despatched","M10")) screen print #bline+3 68 8 1 (format("Deleted","M10")) END FUNCTION 'Footer() FUNCTION MoveRight() if #appt < 7 #appt = #appt + 1 if col = 10 ' check that cursor does not go to col 11 beep return (1) end if col = col + 1 suspendone keys Right,F8 end if return (0) END FUNCTION ' MoveRight() FUNCTION CheckFree() if indirect("[A"|str(col-3)|"]") = "None" return (0) else return (-1) end if END FUNCTION ' CheckFree() FUNCTION CheckBooked() x=indirect("[B"|str(col-3)|"]") 'message "x is:"&str(x) if indirect("[B"|str(col-3)|"]") = "A" return (0) elseif indirect("[B"|str(col-3)|"]") = "R" return (0) end if y=indirect("[A"|str(col-3)|"]") #asc=asc(right(y,1)) 'message "#asc is:"&str(#asc) if #asc > 57 or #asc < 48 'message "Not number" return (-1) ' NOT a job nr ' if indirect("[A"|str(col-3)|"]") = "None" ' return (-1) ' elseif indirect("[A"|str(col-3)|"]") = "SUNDAY" ' return (-1) ' elseif indirect("[A"|str(col-3)|"]") = "BNKHOL" ' return (-1) ' elseif indirect("[A"|str(col-3)|"]") = "ABSENT" ' return (-1) ' elseif indirect("[A"|str(col-3)|"]") = "ASSIST" ' return (-1) ' elseif indirect("[A"|str(col-3)|"]") = "ÛÛÛÛÛÛÛÛ" ' return (-1) else return (0) end if END FUNCTION ' CheckBooked() FUNCTION CheckNr() ' checks for JobNr - if not found x = colpopup(12,48,16,"ÿJobÿNumber CustomerÿName","",1,0,colSf,colSb,colIf,colIb) if x = 0 if ptstr = "CustomerÿName" x = EnterCustName() if x = -1 return (-1) end if ' vloadif(dpath|"ordstat4.vw") ' order change key "[Job_Nr]" ' x = SetupDetails() ' if x = -1 ' continue while ' end if ' end while else ' x = fentrybox(" Enter Order Nr or {Esc} to exit ",6,shopmask,"") ' if x = -1 ' return (-1) ' elseif x = 0 ' jobnr = ptstr ' end if x = fentrybox(" Enter Order Nr or {Esc} to exit ",6,shopmask,"") 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 end if elseif x = -1 return (-1) end if END FUNCTION ' CheckNr() FUNCTION ApptsMenu() local m1 m2 m3 m4 m5 m6 m7 m8 m9 $ch ma m0 as cfp m0="ÿÿMoveÿAppointments" m1="ÿÿBookÿAppointments" m7="ÿReservation/Warranty" m2="ÿConvertÿReservations" m3="ÿÿClearÿAppointments" m4="ÿÿMarkÿFitterÿABSENT" m5="ClearÿABSENT/Assisting" m6="ÿÿUnlistedÿfitter/day" m8="ÿÿÿAlterÿApptÿslots" m9="ÿÿÿFitterÿtoÿASSIST" while true x=posncolpopup(10,42,23,m1&m7&m0&m2&m3&m8&m4&m5&m9&m6,"",1,0,colSf,colSb,colIf,colIb,linenr) if x = -1 return (-1) end if linenr = ptval-1 if ptstr = m2 ' convert reserv'n to Appt error off ftgdate = [Date] if cerror vloadif(dpath|"shwappt5.vw") ftgdate = [Date] end if error on if days(ftgdate) = days(today) continue while end if cr = Conv_Resvn() if cr = 1 vloadif(dpath|"shwappt5.vw") ftgdate = [Date] $ftrcode = right([DayFitter],6) 'message "$ftrcode is:"&str($ftrcode) elseif cr = 2 vloadif(dpath|"shwappt5.vw") ftgdate = [Date] 'message "jobnr is:"&str(jobnr) $ftrcode = right([DayFitter],6) 'message "$ftrcode is:"&str($ftrcode) elseif cr = -1 return (-1) end if elseif ptstr = m1 'Book Appt 'message "L1619/ BookAppt" vloadif(dpath|"shwappt5.vw") 'message "Screen used is:"&apinfo(ap_filex) ftgdate = [Date] if days(ftgdate) = days(today) ' message "userid is:"&str(userid) ' message "$permit is:"&str($permit) if userid <> $permit messbox(" Cannot alter today's appointments! ",0,0,1) continue while end if end if cf = CheckFree() ' 0=clear; -1 taken message "cf is:"&str(cf) if cf = -1 continue while end if ts = ReserveAppt() if ts = 1 vloadif(dpath|"shwappt5.vw") ftgdate = [Date] $ftrcode = right([DayFitter],6) 'message "$ftrcode is:"&str($ftrcode) elseif ts = 2 vloadif(dpath|"shwappt5.vw") ftgdate = [Date] 'message "jobnr is:"&str(jobnr) $ftrcode = right([DayFitter],6) 'message "$ftrcode is:"&str($ftrcode) end if return (-1) elseif ptstr = m3 ' Clear Appt and return to dbase lr = 0 ftgdate = [Date] if days(ftgdate) = days(today) if userid <> $permit messbox(" Cannot alter today's appointments! ",0,0,1) continue while end if end if if days(ftgdate) "O" if base <> "S" if base <> "F" if base <> "P" if base <> "R" continue while end if end if end if end if end if #appt = col - 3 ftrname = [Nickname] $dow = [DOW] ftgdate = [Date] if indirect("[A"|str(col-3)|"]") = "None" Absent("ABSENT","A") else continue while end if elseif ptstr = m5 ' re-instate absence ftgdate = [Date] if days(ftgdate) = days(today) continue while end if if base <> "O" if base <> "S" if base <> "F" if base <> "P" if base <> "R" continue while end if end if end if end if end if ' if base <> "O" ' if base <> "S" ' continue while ' end if ' end if #appt = col - 3 ftrname = [Nickname] $dow = [DOW] ftgdate = [Date] if indirect("[B"|str(col-3)|"]") = "A" ReInstate() else continue while end if elseif ptstr = m8 'increase APPT slots as = AlterSlots_1() if as = -1 return (-1) end if vloadif(dpath|"shwappt5.vw") elseif ptstr = m7 ' reservations x=ReserveMenu() if x = -1 return (-1) end if elseif ptstr = m6 ' future appt x=NewDate() 'L1284 elseif ptstr = m0 ' Move Appt messbox(" Not yet in use ",0,0,1) ' ftgdate = [Date] ' if days(ftgdate) = days(today) ' if userid <> $permit ' messbox(" Cannot alter today's appointments! ",0,0,1) ' continue while ' end if ' end if ' ma = MoveAppt() ' if ma = -1 ' return (-1) ' elseif ma = 1 ' vloadif(dpath|"shwappt5.vw") ' ftgdate = [Date] ' $ftrcode = right([DayFitter],6) 'message "$ftrcode is:"&str($ftrcode) ' ' elseif ma = 2 ' ' vloadif(dpath|"shwappt5.vw") ' ' ftgdate = [Date] 'message "jobnr is:"&str(jobnr) ' ' $ftrcode = right([DayFitter],6) 'message "$ftrcode is:"&str($ftrcode) ' end if ' return (-1) end if end while END FUNCTION ' ApptsMenu() FUNCTION CancelResvn() local $mess $chk $chk = mid(indirect("[A"|str(col-3)|"]"),2,1) if chkstr($chk,"1 2 3 4 5 6 7 8 9 0") = 0 messbox(" Not a Reservationÿ",0,0,1) return (-1) end if repaint off $dfa = [DayFitter]|str(col-3) 'message "$dfa is:"&str($dfa) y=indirect("[A"|str(col-3)|"]") 'message "y is:"&str(y) #asc=asc(right(y,1)) 'message "#asc is:"&str(#asc) if #asc > 90 or #asc < 65 'message "Not uppercase letter" return (-1) 'NOT a job nr end if jobnr = indirect("[A"|str(col-3)|"]") ' message "jobnr is:"&str(jobnr) #appt = col - 3 ftrname = [Nickname] $dow = [DOW] vloadif(dpath|"appntmnt.vws") $mess = filelookup([appntmnt.DFA],[appntmnt.DelAddr&Code],$dfa) $refnr = left($mess,6) 'message "$refnr is:"&str($refnr) $cust = right($mess,len($mess)-7) $user = jobnr ' if $menu = "offc" or $menu = "shop" vloadif("oldpurch.vws") resvdat = filelookup([author],[Base],$user) vunloadif("oldpurch.vws") vloadif(dpath|"appntmnt.vws") x = ChkAreas(resvdat,areas) 'message "x is:"&str(x) if x = -1 '0=found in string; -1= NOT found messbox(" You can only cancel your own shop's reservations! Contact HO (ref 2) ",0,0,1) return (-1) end if end if while true x = entryline(" Enter Reservation ref for"&$cust,6,resref,"",22,1,80) if x = -1 return (-1) ' NOT booked else ' message "ptstr is:"&str(ptstr) '########## ' message "$refnr is:"&str($refnr) '######## if ptstr <> $refnr x = messline(" Incorrect reference! ",0,0,1,22,1,80) continue while else order change key "[DFA]" data find "[DFA]" equal $dfa options "" if cerror ' if none - then return x = messbox(" Job Nr not found ",0,0,1) return (0) ' NOT booked end if lock-record [Job_Nr] = "None" [DelAddr&Code] = "Cancelled by"&userid&"on"&date2(today) ' [DelAddr&Code] = "" [Entered_By] = userid [Date_Altered] = today [Time] = now [N_name] = "" [Status] = "" write-record vloadif(dpath|"shwappt5.vw") ' message "jobnr is:"&str(jobnr) lock-record dbput("[A"|str(col-3)|"]","None") dbput("[B"|str(col-3)|"]","") write-record exit while end if end if end while mr = MoveRight() return (0) END FUNCTION ' CancelResvn() FUNCTION ApptReservn() $dfa = [DayFitter]|str(col-3) ' message "$dfa is:"&str($dfa) #appt = col - 3 ftrname = [Nickname] $ftrcode= right([DayFitter],6) 'message "$ftrcode) is:"&str($ftrcode) $dow = [DOW] if indirect("[A"|str(col-3)|"]") = "None" z = BookReservn() if z = -1 ' Esc return (-1) elseif z = 1 ' NULL return return (1) end if else ' jobnr <> "None" return (-1) end if END FUNCTION 'ApptReservn() FUNCTION BookReservn() '1=ALL ; 2=SOME ; 0=NONE resv'd; -1=Esc/NULL return local ba k $resref $m4 z while true while true x = entryline("Enter Customer's name/notes etc",23,"","",22,1,80) if x = 0 ' ask for Customer's name if ptstr = "" continue while end if $cust = proper(ptstr) exit while elseif x = -1 return (-1) end if end while while true x = entryline(" Enter Reservation reference ",6,resref,"",22,1,80) if x = -1 return (-1) end if $resref = ptstr '|"-00" $comment = left($resref|"/"|$cust,30) jobnr = userid exit while end while x = messline("Confirm ref:"&$resref&"for"&$cust|"? (y/n) ",1,1,1,21,1,80) if ptstr == "Y" ' Book appt exit while else continue while end if end while while true if indirect("[A"|str(col-3)|"]") = "None" $dfa = [DayFitter]|str(col-3) ' message "$dfa is:"&str($dfa) $appth = case #appt (1,"1st")(2,"2nd")(3,"3rd") else str(#appt)|"th" y1 = format("Now reserving appt's for"&"-"&$cust,"M80") screen print 1 1 fgp bgp y1 x = messline(" Reserve"&ftrname|"'s"&$appth&"appointment on"&$dow&date2(ftgdate)|"? (y/n) ",1,1,1,21,1,80) if ptstr == "Y" ' Book appt ba = ReservnBooking() ' message "1=Booked; 0=Not booked:"&str(ba) if ba = 0 ' Appt NOT booked repaint on repaint elseif ba = 1 ' Appt BOOKED mr = MoveRight() if mr = 1 return (1) 'Null return end if repaint on repaint continue while end if else ' DO NOT book appt return (1) 'Null return end if else messbox(" Appointment already booked ",0,0,1) return (-1) 'Null return end if end while END FUNCTION ' BookReservn() FUNCTION ShowRecall() vloadif(dpath|"shwappt5.vw") ' message "jobnr is:"&str(jobnr) repaint on repaint y2 = format("ÿÿÿÿÿÿÿÿÿÿ{B}ook recallÿÿÿÿÿÿ {C}lear recallÿÿÿÿÿÿ {F10} to finishÿÿÿÿÿÿÿÿÿ","M80") screen print 21 1 fgp bgp y2 END FUNCTION 'ShowRecall() FUNCTION ReservnBooking() repaint off vloadif(dpath|"bookappt.vw") order change key "[DFA]" data find "[DFA]" equal $dfa options "" if cerror ' if none - then return x = messbox(" Job Nr not found ",0,0,1) return (0) ' NOT booked end if lock-record [Job_Nr] = jobnr [DelAddr&Code] = $comment [Entered_By] = userid [Date_Altered] = today [Time] = now [N_name] = ftrname [Status] = "R" write-record repaint off vloadif(dpath|"shwappt5.vw") ' message "jobnr is:"&str(jobnr) lock-record dbput("[A"|str(col-3)|"]",jobnr) dbput("[B"|str(col-3)|"]","R") write-record return (1) END FUNCTION 'ReservnBooking() function regen(z,r1,c1,r2,c2,pl,rec,recs,lc,fg,bg,fmt) local x t drows screen clear box r1 c1 r2 c2 fg bg 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 fg bg format fmt ptary[t] drows=drows+1 end if end if end for return (drows) end function 'regen() FUNCTION CheckRecall() if indirect("[B"|str(col-3)|"]") = "C" return (0) else return (-1) end if END FUNCTION ' CheckRecall() FUNCTION Warranty() local nr nr = NavRecall() if nr = -1 return (-1) elseif nr = 0 ' write record to JOBS_OUT file end if END FUNCTION 'Warranty() FUNCTION NavRecall() local x j k l nextcell sortblock c ts rd res cr cf cb wr quiet on y1 = format("Recalls for Warranty Work","M80") screen print 1 1 fgp bgp y1 y2 = format("ÿÿÿÿÿÿÿÿÿÿ{B}ook recallÿÿÿÿÿÿ {C}lear recallÿÿÿÿÿÿ {F10} to finishÿÿÿÿÿÿÿÿÿ","M80") screen print 21 1 fgp bgp y2 while TRUE 'message "col is:"&str(col) quiet on screen clear box 24 1 sch scw 0 0 no-border x = inchar 'message "x) is:"&str(x) if x = {Up} if record = 1 beep continue while end if data goto record previous if indirect("[A"|str(col-3)|"]") = "ÛÛÛÛÛÛÛÛ" data goto record previous end if elseif x = {Down} if record = records beep continue while end if data goto record next if indirect("[A"|str(col-3)|"]") = "ÛÛÛÛÛÛÛÛ" data goto record next end if elseif x = {Right} if col = 10 ' check that cursor does not go to col 11 beep continue while end if col = col + 1 suspendone keys Right,F8 elseif x = {Left} if col = 4 ' check that cursor does not go to col 3 beep continue while end if suspendone keys Left,F8 col = col - 1 elseif x = {PgDn} j = record ' find present pos'n j = j + 17 ' if j > records data goto record last else data goto record record-number j end if if indirect("[A"|str(col-3)|"]") = "ÛÛÛÛÛÛÛÛ" data goto record next end if elseif x = {PgUp} j = record ' find present pos'n j = j - 17 ' go up 17 rows if j < 1 ' ensure it does not goes above row 1 data goto record first else data goto record record-number j end if if indirect("[A"|str(col-3)|"]") = "ÛÛÛÛÛÛÛÛ" data goto record previous end if elseif x = {^End} data goto record last elseif x = {^Home} data goto record first elseif x = {b} ' reserve Recall cf = CheckFree() ' 0=clear; -1 taken message "cf is:"&str(cf) if cf = -1 continue while end if ftgdate = [Date] if days(ftgdate) = days(today) messbox(" Cannot reserve today's appointments! ",0,0,1) continue while end if repaint off x = EnterCustName() if x = -1 continue while end if y1 = format("Recall to"&title1,"M80") screen print 1 1 fgp bgp y1 repaint off vloadif(dpath|"recall1.vw") order change key "[Job_Nr]" data query execute "job_reqn.dfq" index "job_reqn.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' ³ QUERY is: [Job_Nr] = jobnr ³ ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror ' messbox(" Job Nr NOT found ",0,0,1) return (1) end if order sort now dictionary "x" fields "[Date]" ascending BuildList() x = FitterPopup(3,59,15,$ftr,"Attendances",1,0) $ftr = ptstr vloadif(dpath|"shwappt5.vw") $ftr_ch = mid([DayFitter],6,6) ' if $ftr <> $ftr_ch ' message "Not the same fitter" messbox(" You did not choose this fitter! Continue anyway? (y/n) ",1,0,1) if ptstr == "n" y1 = format("Recall to"&title1,"M80") screen print 1 1 fgp bgp y1 repaint on repaint continue while else $ftr = $ftr_ch end if end if res = ReserveRecall() if res = 1 vloadif(dpath|"shwappt5.vw") elseif res = -1 continue while end if ShowRecall() elseif x = {c} ' Clear recall cb = CheckRecall() 'message "cb is:"&str(cb) if cb = -1 continue while end if ftgdate = [Date] if days(ftgdate) = days(today) ' messbox(" Cannot alter today's appointments! ",0,0,1) continue while end if cr = CancelRecall() ShowRecall() elseif x = {F10} return (0) end if end while END FUNCTION 'NavRecall FUNCTION BuildList() local y $list = "" $ftr = "" $ftrcode = "" for i = 1 to records $dfa = left([DFA],11) if chkstr($dfa,$list) = -1 ' NOT in list $list = $list&$dfa y = [Fitter_Code] x = left(date1([Date]),6)|"ÿ-ÿ"|left([N_name]|"ÿÿÿÿÿÿÿÿ",8) x = ReplaceHardSpace2(x,17) $ftr = $ftr&x $ftrcode = $ftrcode&y end if data goto record next end for custcode = [Customer_Code] END FUNCTION ' BuildList() FUNCTION ReplaceHardSpace2(str1,bw) local j r m l_last #addn 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 ' ReplaceHardSpace2() FUNCTION ReserveRecall() local chkrecall $dfa = [DayFitter]|str(col-3) ' message "$dfa is:"&str($dfa) #appt = col - 3 ftrname = [Nickname] $ftrcode= right([DayFitter],6) 'message "$ftrcode) is:"&str($ftrcode) $dow = [DOW] if indirect("[A"|str(col-3)|"]") = "None" z = Recall() if z = -1 ' Esc return (-1) elseif z = 1 ' NULL return if rb = 1 repaint off vloadif(dpath|"custsel6.vw") lock-record [Order_Status] = "C" write-record increment(dpath|"recalls.dat",1) chkrecall = "R"|right("00000"|str(ptval),5) ' vloadif(dpath|"recalls.vws") data enter lock [Ref_Nr] = recallnr [Job_Nr] = jobnr [EntryDate] = today [Action] = $instr [Cust_Code] = custcode [Ftr_Code] = $ftr [Updated_By] = userid [Updated_On] = today ' [Status] = $ordstat write-record end if return (1) end if else ' jobnr <> "None" return (-1) end if END FUNCTION 'ReserveRecall() FUNCTION Recall() '1=ALL ; 2=SOME ; 0=NONE resv'd; -1=Esc/NULL return local ba k $resref $m4 z vu_instr $before while true screen save 16 14 19 66 $before y = format("Press F10 to finish","M80") screen print 21 1 15 1 y screen editor 16 14 19 66 15 12 "ÿNotes/instructions for Recallÿ" VARIABLE $instr "" screen save 16 14 19 66 vu_instr smartpeek $_lastkey z if z <> {F10} messbox(" Must use {F10} to save record!! ",0,0,1) continue while end if screen shortrestore vu_instr messline(" Confirm correct and continue? (y/n) ",1,1,1,21,1,80) if ptstr == "y" screen shortrestore $before exit while else continue while end if end while ' create Recall ref: fopen dpath|"recalls.dat" as 1 fread 1 into recallnr fclose 1 recallnr = "R"|right("00000"|str(recallnr),5) ' message "recallnr is:"&str(recallnr) messbox(" NOTE!! Reference for this recall is"&recallnr|". Continue and book? (y/n) ",1,0,1) if ptstr == "n" return (1) end if vloadif(dpath|"shwappt5.vw") rb = 0 while true if indirect("[A"|str(col-3)|"]") = "None" $dfa = [DayFitter]|str(col-3) ' message "$dfa is:"&str($dfa) $appth = case #appt (1,"1st")(2,"2nd")(3,"3rd") else str(#appt)|"th" $cust = right(title1,len(title1)-7) y1 = format("Booking Recall for"&"-"&$cust,"M80") screen print 1 1 fgp bgp y1 x = messline(" Book"&ftrname|"'s"&$appth&"appointment for recall on"&$dow&date2(ftgdate)|"? (y/n) ",1,1,1,21,1,80) if ptstr == "Y" ' Book appt ba = BookRecall() ' message "1=Booked; 0=Not booked:"&str(ba) if ba = 0 ' Appt NOT booked repaint on repaint elseif ba = 1 ' Appt BOOKED rb = 1 mr = MoveRight() if mr = 1 return (1) 'Null return end if repaint on repaint continue while end if else ' DO NOT appt for RECALL return (1) 'Null return end if else messbox(" Appointment already booked ",0,0,1) return (-1) 'Null return end if end while END FUNCTION ' Recall() FUNCTION BookRecall() messboxwait(" Module not yet operational ",0,0,1) return (0) ' NOT booked ' repaint off ' vloadif(dpath|"bookappt.vw") ' order change key "[DFA]" ' data find "[DFA]" equal $dfa options "" ' if cerror ' if none - then return ' x = messbox(" Job Nr not found ",0,0,1) ' return (0) ' NOT booked ' end if ' $ordstat = "L" ' lock-record ' [Job_Nr] = jobnr ' [DelAddr&Code] = recallnr ' [Entered_By] = userid ' [Date_Altered] = today ' [Time] = now ' [N_name] = ftrname ' [Status] = $stat ' write-record ' ' repaint off ' vloadif(dpath|"shwappt5.vw") ' message "jobnr is:"&str(jobnr) ' lock-record ' dbput("[A"|str(col-3)|"]",jobnr) ' dbput("[B"|str(col-3)|"]",$stat) ' write-record ' return (1) END FUNCTION ' BookRecall() FUNCTION CancelRecall() local $mess $chk repaint off $dfa = [DayFitter]|str(col-3) 'message "$dfa is:"&str($dfa) y=indirect("[A"|str(col-3)|"]") #asc=asc(right(y,1)) 'message "#asc is:"&str(#asc) if #asc > 57 or #asc < 48 'message "Not number" return (-1) ' NOT a job nr end if jobnr = indirect("[A"|str(col-3)|"]") 'message "jobnr is:"&str(jobnr) #appt = col - 3 ftrname = [Nickname] $dow = [DOW] vloadif(dpath|"appntmnt.vws") $mess = filelookup([appntmnt.DFA],[appntmnt.DelAddr&Code],$dfa) $refnr = left($mess,6) 'message "$refnr is:"&str($refnr) $cust = right($mess,len($mess)-7) '########################## $user = jobnr ' if $menu = "offc" or $menu = "shop" vloadif("oldpurch.vws") resvdat = filelookup([author],[Base],$user) vunloadif("oldpurch.vws") vloadif(dpath|"appntmnt.vws") x = ChkAreas(resvdat,areas) 'message "x is:"&str(x) if x = -1 '0=found in string; -1= NOT found messbox(" You can only cancel your own shop's reservations! Contact HO (ref 3) ",0,0,1) return (-1) end if end if ' while true ' x = entryline(" Enter Reservation ref for"&$cust,6,resref,"",22,1,80) ' if x = -1 '########################## ' if userid <> $user ' messbox(" You can ONLY cancel your OWN recalls! Contact Head office ",0,0,1) ' return (-1) ' end if ' end if while true x = entryline(" Enter Customer's Order Nr ",6,shopmask,"",22,1,80) if x = -1 return (0) ' NOT booked else if ptstr <> $refnr x = messline(" Incorrect reference! ",0,0,1,22,1,80) continue while else order change key "[DFA]" data find "[DFA]" equal $dfa options "" if cerror ' if none - then return x = messbox(" Job Nr not found ",0,0,1) return (0) ' NOT booked end if lock-record [Job_Nr] = "None" [DelAddr&Code] = "" [Entered_By] = userid [Date_Altered] = today [Time] = now [N_name] = "" [Status] = "" write-record vloadif(dpath|"shwappt5.vw") ' message "jobnr is:"&str(jobnr) lock-record dbput("[A"|str(col-3)|"]","None") dbput("[B"|str(col-3)|"]","") write-record exit while end if end if end while mr = MoveRight() return (0) END FUNCTION ' CancelRecall() 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 FitterPopup(r1,c1,br,list,msg,num,mnu) local t hml hm cnum mscn pad padc ret colSf = fgp colSb = bgp 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 ptstr=NULL hm = NULL 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],"l",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 fgp bgp pc=1 for c=1 to pl screen print c+r1 lc fgp bgp 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 while TRUE k=inchar screen print r1+c lc fgp bgp plist[rec,2] if plist[rec,1]=1 screen print r1+c sc fgp bgp sym end if if k={Down} if rec=recs if recs<=pl rec=1 c=1 else beep end if else if c = pl screen scroll up r1+1 lc r2 (c2+case num (1,0) else 1) fgp bgp 1 end if c= case c (pl,c) else (c+1) rec=rec+1 end if elseif k={Up} if rec=1 if recs <= pl rec = recs c = pl else beep end if else if c = 1 screen scroll down r1+1 lc r2 (c2+case num (1,0) else 1) fgp bgp 1 end if c= case c (1,c) else (c-1) rec=rec-1 end if elseif k={Home} if c>1 if rec =(rec-c)+1 rec = 1 else rec =(rec-c)+1 end if c=1 else rec=1 c=1 end if elseif k={^Home} if rec = c rec = 1 c=1 else rec = 1 c=1 refresh(c,r1,c1,r2,c2,pad,colSf,colSb) end if elseif k={End} if rec < recs and c < pl if drows < pl rec = recs-pl+1 refresh(c,r1,c1,r2,c2,pad,colSf,colSb) rec = recs c = pl else if rec+(pl-c) < recs rec = rec+(pl-c) c = pl else rec = recs c = pl end if end if end if elseif k={^End} rec = recs-pl+1 c = 1 refresh(c,r1,c1,r2,c2,pad,colSf,colSb) c = pl rec = recs elseif k={PgDn} if rec = recs and c = pl beep elseif c <= pl if rec = recs or rec+pl >= recs rec = recs-pl+1 c = 1 refresh(c,r1,c1,r2,c2,pad,colSf,colSb) c = pl rec = recs else rec = rec+pl refresh(c,r1,c1,r2,c2,pad,colSf,colSb) end if end if elseif k={PgUp} if rec = 1 and c = 1 beep else if recs > pl if (rec-pl)-c <= 1 c = rec-pl if c < 1 c = 1 end if rec = 1 refresh(c,r1,c1,r2,c2,pad,colSf,colSb) rec = c else rec=(rec-pl) refresh(c,r1,c1,r2,c2,pad,colSf,colSb) end if else if rec > 1 rec=1 c=1 end if end if end if elseif k={Enter} screen print r1+c lc fgi bgi plist[rec,2] if num = 1 ret=trim(plist[rec,2]) exit while end if if plist[rec,1] = 1 if udelstr(trim(plist[rec,2]),ret) = 0 ret = ptstr end if plist[rec,1] = 0 cnum=cnum-1 else if cnum = num and not(num=0) beep else ret=trim(ret&plist[rec,2]) plist[rec,1] = 1 cnum=cnum+1 end if end if if rec < recs smartpoke $_key {Down} end if ' elseif k={Esc} ' ret=null ' exit while ' elseif k={F10} ' for c=recs to 1 step -1 ' if plist[c,1]=1 ' ret=ret & trim(plist[c,2]) ' end if ' end for exit while end if if k<> {Enter} screen print r1+c lc fgi bgi plist[rec,2] end if if plist[rec,1]=1 screen print r1+c sc fgi bgi sym end if end while screen save r1 c1 r2+2 c2+1+pad dsa screen shortrestore mscn screen shortrestore psa nr = c clear k dc lc sc recs c2 r2 l blen pl mr pc sym pg i tr drows redimension plist[1,3] if trim(ret) = NULL ptstr = NULL return (-1) else ptstr = group($ftrcode,c) return (0) end if end function 'FitterPopup() FUNCTION ReserveMenu() local m1 m2 m3 m4 m5 m6 m7 m1="ÿReserveÿAppointment" m2="ÿWarrantyÿcall" m3="ÿClearÿReservation" ' m4="ÿMarkÿFitterÿAbsent" ' m5="UnMarkÿFitterÿAbsence" ' m6="ÿUnlistedÿfitter/day" while true x = colpopup(11,55,23,m1&m2&m3,"",1,0,colSf,colSb,colIf,colIb) if x = -1 return (-1) end if if ptstr = m1 cf = CheckFree() ' 0=clear; -1 taken message "cf is:"&str(cf) if cf = -1 continue while end if ftgdate = [Date] if days(ftgdate) = days(today) messbox(" Cannot reserve today's appointments! ",0,0,1) continue while end if res = ApptReservn() if res = 1 vloadif(dpath|"shwappt5.vw") elseif res = -1 continue while end if return (0) ' Show() elseif ptstr = m2 'warranty call wr = Warranty() if wr = -1 continue while end if repaint on repaint return (0) ' Show() elseif ptstr = m3 'Clear reservation cb = CheckBooked() if cb = -1 continue while end if ftgdate = [Date] if days(ftgdate) = days(today) ' messbox(" Cannot alter today's appointments! ",0,0,1) continue while end if cr = CancelResvn() if cr = -1 return (-1) end if return (0) end if end while END FUNCTION ' ReserveMenu() FUNCTION NewGoodsOut() if #delcost = 0 messboxwait(" ZERO cost entered in GOODSOUT file - inform Office (ref"|$refnr|") ",0,0,1) end if ' message "#delcost is:"&str(#delcost) ' message "#dellength is:"&str(#dellength) vloadif(dpath|"goodsout.vws") data enter lock [FtrCode] = $ftrcode [Itemtype] = $itemtype [Date_Out] = date2($deldate) [QuantOut] = #dellength [Cost] = #delcost [Requsn_Nr] = $refnr [RollNr] = $rollnr ' [CPL_Ref] = $rollnr [Job_Nr] = jobnr [Created_By]= userid write-record END FUNCTION 'NewGoodsOut() FUNCTION Delypopup(r1,c1,br,list,msg,num,mnu,linenr) local t hml hm cnum mscn pad padc ret colSf = fgp colSb = bgp recval = 0 #needed = 0 if exact(trim(list),NULL)=FALSE recs = uistrcnt(list) if recs = 0 return (-3) end if else return (-2) end if redimension plist[recs,5] 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(37) cnum=0 blen=0 l=blen for c=1 to recs plist[c,2]=group(list,c) plist[c,4]="S" ' changes to "A" before first addn l=len(plist[c,2]) plist[c,1]=0 if l>blen blen=l end if plist[c,5]=namelist[c,1] 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],"l",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 15 0 no-border pc=1 for c=1 to pl screen print c+r1 lc 15 0 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 print r1+c lc fgp bgp plist[rec,2] screen print r1+c lc 15 0 plist[rec,2] while true if c = pl screen print r1+c lc fgi bgi plist[rec,2] exit while elseif c = linenr+1 screen print r1+c lc fgi bgi plist[rec,2] exit while else if c = pl screen scroll up r1+1 lc r2 (c2+case num (1,0) else 1) 15 0 1 end if c= case c (pl,c) else (c+1) rec=rec+1 continue while end if end while while TRUE k=inchar screen print r1+c lc 15 0 plist[rec,2] if plist[rec,1]=1 screen print r1+c sc 15 0 sym end if if k={Down} if rec=recs if recs<=pl rec=1 c=1 else beep end if else if c = pl ' screen scroll up r1+1 lc r2 (c2+case num (1,0) else 1) fgp bgp 1 screen scroll up r1+1 lc r2 (c2+case num (1,0) else 1) 15 0 1 end if c= case c (pl,c) else (c+1) rec=rec+1 end if elseif k={Up} if rec=1 if recs <= pl rec = recs c = pl else beep end if else if c = 1 ' screen scroll down r1+1 lc r2 (c2+case num (1,0) else 1) fgp bgp 1 screen scroll down r1+1 lc r2 (c2+case num (1,0) else 1) 15 0 1 end if c= case c (1,c) else (c-1) rec=rec-1 end if elseif k={Esc} ret=null exit while end if if k<> {Enter} screen print r1+c lc fgi bgi plist[rec,2] end if if plist[rec,1]=1 screen print r1+c sc fgi bgi sym end if end while screen save r1 c1 r2+2 c2+1+pad dsa screen shortrestore mscn screen shortrestore psa nr = c 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) ptval = nr return (0) end if END FUNCTION 'delypopup() FUNCTION Screen_1() repaint on repaint screen shortrestore S_top screen shortrestore S_LHS screen shortrestore S_RHS if vo=0 if areas!"W" y2 = format(" {A}ppointments - Job {D}etails - Deli{V}eries - {R}eturns - {Esc} ","M80") else y2 = format(" {A}ppointments - ÿJob {D}etails - Deli{V}eries - {Esc}","M80") end if ' screen print 21 1 fgp bgp y2 screen print 29 15 fgp bgp y2 y1 = format(" ","M80") ' screen print 22 1 fgp bgp y1 screen print 30 15 fgp bgp y1 else y2 = format(" ","M80") ' screen print 21 1 fgp bgp y2 screen print 29 15 fgp bgp y2 y1 = format(" ","M80") ' screen print 22 1 fgp bgp y1 screen print 30 15 fgp bgp y1 end if ' SCREEN SAVE 5 5 29 78 $screen SCREEN SAVE 5 17 29 90 $screen SCREEN SHORTRESTORE $screen 'NEW END FUNCTION 'Screen_1() FUNCTION DeliverMenu(dm) ' from L4748 local ca Background() $deldate = [Date] ' message "$date is:"&str($date) cb=CheckBooked() ' message "cb is:"&str(cb) if cb=-1 return (-1) end if $thisday = left(dayname($deldate),3)&date2($deldate) repaint off ss = SetupScreen(dm) if ss = 1 repaint off WC() vunloadif($gdsout1) vunloadif($gdsout2) return (-1) end if ' message "dm is:"&str(dm) ca = ChooseAction(dm) ' L3341 repaint off WC() vunloadif($gdsout1) vunloadif($gdsout2) if dm = 0 MarkDeliveries(ca) end if Show() END FUNCTION ' DeliverMenu() FUNCTION AllThisReqn() 'check for existing deliveries and delete repaint off #dellength = [Quant_OS] ' if #dellength = 0 messboxwait(" Already marked for delivery ",0,0,1) return (1) end if #delcost = [Cost_OS] ' $refnr = [Reference_Nr] $rollnr = [RollNr] $itemtype = [Item_Type] 'message "$itemtype is:"&str($itemtype) 'create record in GOODSOUT for req'n data goto window 2 window zoom vloadif(dpath|"goodsout.vws") NewGoodsOut() vloadif(dpath|"gds_out2.vw") window zoom 'update BAL_OS in REQUSN data goto window 1 window zoom lock-record [Cost_OS] = 0 [Quant_OS] = 0 write-record window zoom END FUNCTION ' AllThisReqn() FUNCTION DeliverPart() 'check for existing deliveries and delete repaint off $itemtype = [Item_Type] 'message "$itemtype is:"&str($itemtype) if $itemtype = "C" messboxwait(" Stock carpet req'ns cannot be split ",0,0,1) return (1) end if #oslength = [Quant_OS] #oscost = [Cost_OS] ' if #oslength = 0 messboxwait(" Already marked for delivery ",0,0,1) return (1) end if $refnr = [Reference_Nr] $rollnr = [RollNr] while true smartpoke $_ins 0 x = fentrybox(" Amount to deliver on"&date2($deldate)|" ",8,"",#oslength) if x = -1 smartpoke $_ins 1 return (1) end if #dellength = val(ptstr) if #dellength > #oslength messboxwait(" Amount to deliver is more than outstanding amount ",0,0,1) continue while end if #delcost = #oscost*(#dellength/#oslength) ' exit while end while 'create record in GOODSOUT for req'n data goto window 2 window zoom NewGoodsOut() vloadif(dpath|"gds_out2.vw") window zoom 'update BAL_OS in REQUSN data goto window 1 window zoom lock-record [Quant_OS] = #oslength - #dellength [Cost_OS] = #oscost - #delcost write-record #oslength = [Quant_OS] #oscost = [Cost_OS] '' message "#oslength/Quant_OS is:"&str(#oslength)' message "#oscost is:"&str(#oscost) window zoom smartpoke $_ins 1 repaint on repaint END FUNCTION ' DeliverPart() FUNCTION AllUndeliveredReqns() data goto record first for i = 1 to records repaint off #dellength = [Quant_OS] 'message "#dellength/Quant_OS is:"&str(#dellength) if #dellength = 0 data goto record next continue for end if $refnr = [Reference_Nr] $rollnr = [RollNr] #delcost = [Cost_OS] ' message "#delcost/Cost_OS is:"&str(#delcost) $itemtype = [Item_Type] 'message "$itemtype is:"&str($itemtype) 'create record in GOODSOUT for req'n data goto window 2 window zoom NewGoodsOut() vloadif(dpath|"gds_out2.vw") window zoom 'update BAL_OS in REQUSN data goto window 1 window zoom lock-record [Quant_OS] = 0 [Cost_OS] = 0 write-record window zoom data goto record next end for data goto record first END FUNCTION ' AllUndeliveredReqns() FUNCTION SetupScreen(dm) ' temporary rem out until screens cleaned up - 151214 screen save 4 1 22 15 S_LHS screen save 4 90 22 110 S_RHS screen save 1 1 3 110 S_top if dm = 0 $gdsout1 = "gds_out1.vw" $gdsout2 = "gds_out2.vw" else $gdsout1 = "gdsout1a.vw" $gdsout2 = "gdsout2a.vw" end if vloadif(dpath|$gdsout1) order change key "[Job_Nr]" data query execute "job_reqn.dfq" index "job_reqn.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' ³ QUERY is: [Job_Nr] = jobnr ³ ' and ' not(deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror messboxwait(" No requisitions entered for this job ",0,0,1) return (1) end if window split vertical 70 data goto window 2 vloadif(dpath|$gdsout2) data goto window 1 window link "[Reference_Nr]" $gdsout2 "[Reference_Nr]" END FUNCTION ' SetupScreen() FUNCTION WC() error off while true window close if cerror exit while end if end while END FUNCTION ' WC() FUNCTION ChooseAction(vo) local s1 ' y2 = format(" {A}ppointments -ÿJob {D}etails - Deli{V}eries - {R}eturns - {Esc}","M80") Screen_1() ptval=0 while true ptval = navrecs() if ptval = {C} or ptval = {c} ' Cancel delivery for this day if vo=1 'message "vo is (1=ftg date in the past):"&str(vo) if [Item_Type]<>"F" messboxwait(" Only FITTINGS can be cancelled ",0,0,1) continue while end if end if CancelThisItem() Screen_1() elseif ptval = {A} or ptval = {a} ' Deliver ALL this req'n if vo = 1 continue while end if AllThisReqn() Screen_1() elseif ptval = {U} or ptval = {u} ' Deliver ALL undelivered if vo = 1 continue while end if AllUndeliveredReqns() Screen_1() elseif ptval = {P} or ptval = {p} if vo = 1 continue while end if DeliverPart() Screen_1() elseif ptval = {Esc} if vo = 1 return (1) end if messbox(" Finished? (y/n) ",1,1,0) if ptstr == "y" progress(15,10," Checking status of Allocation/Delivery ",0) x=ChkDeliveries() return (x) else continue while end if end if end while END FUNCTION ' ChooseAction() FUNCTION CancelThisItem() 'find GOODSOUT records for this item repaint off ' $reqnnr = [Reference_Nr] #oscost = [Cost_OS] 'message "#oscost is:"&str(#oscost) prodMRC = [Product_MRC] 'message "prodMRC is:"&str(prodMRC) #oslength = [Quant_OS] 'message "#oslength is:"&str(#oslength) ' message "$reqnnr is:"&str($reqnnr) if [Quant_OS] = [Length_Quantity] messboxwait(" No deliveries to cancel ",0,0,1) return (1) end if reqnnr = [Reference_Nr] 'message "reqnnr is:"&str(reqnnr) data goto window 2 vloadif(dpath|"goodsout.vws") ' message "$deldate is:"&str(date2($deldate)) 'message "vo is:"&str(vo) if vo = 1 'looking at past dates - ONLY unprocessed ftgs can be deleted data query execute "gdsout1a.dfq" index "gdsout1a.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Requsn_Nr]=reqnnr ' and ' days([Date_Out])=days($deldate) ' and ' len([Document])=0 ' and ' [Itemtype]="F" ' and ' not (deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror ' no deliveries for this day ' message "prodMRC is:"&str(prodMRC) messboxwait("L3407/"|prodMRC&"cannot alter ",0,0,1) vloadif(dpath|"gdsout2a.vw") data goto window 1 return (1) end if if [Document]=blank ' message "May be processed - no docref for"&reqnnr 'find total [QuantOut] for records to be deleted #dellength = filesum([QuantOut]) 'message "#dellength is:"&str(#dellength) #delcost = filesum([Cost]) 'message "#delcost is:"&str(#delcost) 'delete record data query execute "delete.dfq" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' not(deleted) replace delete ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ order change physical vloadif(dpath|"gdsout2a.vw") 'update BAL_OS in REQUSN data goto window 1 #oslength = #oslength + #dellength 'message "#oslength is:"&str(#oslength) #oscost = #oscost + #delcost 'message "#oscost + #delcost is:"&str(#oscost) window zoom lock-record [Quant_OS] = #oslength [Cost_OS] = #oscost write-record window zoom else messboxwait(" Already processed into Fitter's payment records ",0,0,1) ' message "docref present - already processed"&reqnnr end if elseif vo = 0 data query execute "gds_out1.dfq" index "gds_out1.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Requsn_Nr]=reqnnr ' and ' days([Date_Out])=days($deldate) ' and ' len([Document])=0 ' and ' not (deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror ' no deliveries for this day messboxwait("L3389 -"|prodMRC&"already delivered or booked out ",0,0,1) vloadif(dpath|"gds_out2.vw") data goto window 1 return (1) end if 'find total [QuantOut] for records to be deleted #dellength = filesum([QuantOut]) 'message "#dellength is:"&str(#dellength) #delcost = filesum([Cost]) 'message "#delcost is:"&str(#delcost) 'delete all records data query execute "delete.dfq" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' not(deleted) replace delete ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ order change physical vloadif(dpath|"gds_out2.vw") 'update BAL_OS in REQUSN data goto window 1 #oslength = #oslength + #dellength 'message "#oslength is:"&str(#oslength) #oscost = #oscost + #delcost 'message "#oscost + #delcost is:"&str(#oscost) window zoom lock-record [Quant_OS] = #oslength [Cost_OS] = #oscost write-record window zoom data goto record next end if END FUNCTION ' CancelThisday() FUNCTION CancelAllThisday() data goto record first for i = 1 to records repaint off #oscost = [Cost_OS] 'message "#oscost is:"&str(#oscost) prodMRC = [Product_MRC] 'message "prodMRC is:"&str(prodMRC) #oslength = [Quant_OS] if [Quant_OS] = [Length_Quantity] data goto record next continue for end if reqnnr = [Reference_Nr] 'message "reqnnr is:"&str(reqnnr) data goto window 2 vloadif(dpath|"goodsout.vws") data query execute "gds_out1.dfq" index "gds_out1.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' ³ QUERY is: [Requsn_Nr]=reqnnr ³ ' and ' [Date_Requisitioned]=days($deldate) ' and ' len([Document])=0 ' and ' not(deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror ' no deliveries for this day messboxwait("L3382 -"|prodMRC&"already delivered or booked out ",0,0,1) ' messboxwait("ÿ"|prodMRC&"already delivered or booked out ",0,0,1) vloadif(dpath|"gds_out2.vw") data goto window 1 data goto record next continue for end if 'find total [QuantOut] for records to be deleted #dellength = filesum([QuantOut]) 'message "#dellength is:"&str(#dellength) #delcost = filesum([Cost]) 'message "#delcost is:"&str(#delcost) data query execute "delete.dfq" 'delete all records ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' not(deleted) replace delete ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ order change physical vloadif(dpath|"gds_out2.vw") 'update BAL_OS in REQUSN data goto window 1 #oslength = #oslength + #dellength 'message "length to add back is:"&str(#oslength) #oscost = #oscost + #delcost 'message "cost to add back is:"&str(#oscost) window zoom lock-record [Quant_OS] = #oslength [Cost_OS] = #oscost write-record window zoom data goto record next end for data goto record first END FUNCTION ' CancelAllThisday() FUNCTION ChkDeliveries() repaint off while true data goto record first for i = 1 to records $itemtype = [Item_Type] data goto window 2 if tablesum([QuantOut],[RollNr]="BESPOK" AND $itemtype<>"O" or [RollNr]="00000/00")>0 data goto window 1 return (2) ' message "Deliveries o/s!!" end if data goto window 1 data goto record next end for data goto record first for i = 1 to records data goto window 2 if tablesum([QuantOut])>0 data goto window 1 return (0) 'message "Deliveries ready" end if data goto window 1 data goto record next end for return (1) 'message "NONE delivered" end while END FUNCTION ' ChkDeliveries() FUNCTION MarkDeliveries(c) $stat = case c (2,"O")(0,"D")(1,"P") ' message "$stat is:"&str($stat) repaint off vloadif(dpath|"bookappt.vw") order change key "[DFA]" data find "[DFA]" equal $dfa options "" if cerror ' if none - then return x = messbox(" $dfa not found ",0,0,1) Show() return (0) ' NOT booked end if lock-record [Entered_By] = userid [Date_Altered] = today [Time] = now [Status] = $stat write-record vloadif(dpath|"shwappt5.vw") lock-record ' dbput("[A"|str(col-3)|"]",jobnr) dbput("[B"|str(col-3)|"]",$stat) write-record return (1) END FUNCTION ' MarkDeliveries() FUNCTION FindFirstJobNr() while true if LookLeft(jobnr) = 0 ' same jobnr if col = 4 ' check that cursor does not go to col 3 beep continue while end if suspendone keys Left,F8 col = col - 1 else exit while end if end while return (0) END FUNCTION ' FindFirstJobNr() FUNCTION ChooseFitter() repaint off vloadif(dpath|"ftr_list.vws") data query execute "ftrundel.dfq" index "ftrs1.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Ftr_Est]="F" and ' not (deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ order sort now dictionary "nickname.idx" fields "[Nickname]" ascending while true x = bpopdb("ftr_list",5,"","[Nickname]","L8","[Fitter_Name]","L0","[Fitter_Code]",3,70,14,80,"",0) if x = -1 repaint off vunloadif("ftr_list.vws") Show() return(-1) else ftrcode = ptstr 'message "ptstr) is:"&str(ptstr) ftrassist = [Nickname] $location = [Location] if ftrassist = ftrname messboxwait(" Same fitter! ",0,0,1) repaint off continue while else exit while end if end if end while repaint off screen shortrestore dsa vunloadif("ftr_list.vws") END FUNCTION ' ChooseFitter() FUNCTION DaysLeft() local mess1 order change physical data goto record last $lastdate = days([Date]) 'message "$lastdate is:"&str($lastdate) #daysleft = days($lastdate)-days(today) 'message "#daysleft is:"&str(#daysleft) data goto record record-number #recs Show() ' if #daysleft < 10 ' mess1 = "Only"&str(#daysleft)&"days left in Appointments file " ' for i = 1 to 3 ' flashmess(mess1,0,0,1) ' wait .2 ' end for ' end if END FUNCTION ' DaysLeft() FUNCTION CheckOSDeliveries() vloadif(dpath|"shwappt3.vw") data query execute "os_dely.dfq" index "os_dely.idx" ' find all records with same jobnr & ftgdate ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Job_Nr] = jobnr ' and ' [Fitting_Date] ' and ' not(deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror messboxwait(" NO appointments booked ",0,0,1) order change physical return (1) else if records = 1 order change physical return (2) else order change physical return (0) end if end if END FUNCTION 'CheckOSDeliveries() FUNCTION CancelAllGoodsOut() vloadif(dpath|"goodsout.vws") ' clear all records for job order change key "[Job_Nr]" while true data query execute "job_reqn.dfq" index "x.idx" ' find all for this job ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Job_Nr] = jobnr ' and ' not(deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror exit while end if data query execute "this_day.dfq" index "ftgday.idx" ' find all for this job ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' date2([Date_Out])=date2(ftgdate) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror exit while end if for i = 1 to records reqnnr = [Requsn_Nr] #dellength = [QuantOut] 'message "#dellength is:"&str(#dellength) #delcost = [Cost] 'message "#delcost is:"&str(#delcost) ' 'update BAL_OS in REQUSN vloadif(dpath|"requsn.vws") order change key "[Reference_Nr]" data find "[Reference_Nr]" equal reqnnr options "" if cerror ' if none - then return messboxwait(" Reqn Nr not found - confirm? (y/n) ",1,0,0) end if #oscost = [Cost_OS] #oslength = [Quant_OS] #oslength = #oslength + #dellength 'message "#oslength is:"&str(#oslength) #oscost = #oscost + #delcost 'message "#oscost is:"&str(#oscost) lock-record [Quant_OS] = #oslength [Cost_OS] = #oscost write-record vloadif(dpath|"goodsout.vws") data goto record next end for data query execute "delete.dfq" 'delete all records ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' not(deleted) replace delete ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ exit while end while vunloadif("goodsout.vws") END FUNCTION ' CancelAllGoodsOut() FUNCTION AlterSlots_1() jobnr = indirect("[A"|str(col-3)|"]") 'message "jobnr is:"&str(jobnr) if asc(mid(jobnr,2,1))>57 or asc(mid(jobnr,2,1))<48 messbox(" Place cursor over Job Nr you wish to alter slots for ",0,0,1) return (-1) end if if $menu = "shop" ' message "jobnr is:"&str(jobnr) resvdat = left(jobnr,1) ' message "resvdat is:"&str(resvdat) x = ChkAreas(resvdat,areas) 'message "x is:"&str(x) if x = -1 '0=found in string; -1= NOT found messbox(" You can only alter app't slots for your own shop's jobs. Contact HO (ref 4) ",0,0,1) return (-1) else AlterSlots_2() end if else AlterSlots_2() end if END FUNCTION ' AlterSlots_1() FUNCTION AlterSlots_2() local cn #remslots #oldslots #newslots ' find Jobnr and nr of existing slots repaint off vloadif(dpath|"cust_ord.vws") order change key "[Job_Nr]" #oldslots = filelookup([Job_Nr],[Appt_Slots],jobnr) 'message "#oldslots is:"&str(#oldslots) #remslots = filelookup([Job_Nr],[Slots_Rem],jobnr) 'message "#remslots is:"&str(#remslots) while true x = fentrybox(" Alter APPT slots for"&jobnr&"from"&str(#oldslots)&"to: ",2,"{#{#}}","") if x = -1 return (1) end if #newslots = val(ptstr) if #newslots < #oldslots-#remslots messbox(" Cannot reduce below number already booked! ",0,0,1) continue while end if messbox(" Confirm"&str(#newslots)&"for"&jobnr|"? (y/n) ",1,1,1) if ptstr == "y" exit while else continue while end if end while 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 lock-record [Appt_Slots]=#newslots [Slots_Rem] = [Slots_Rem] + (#newslots-#oldslots) write-record vunloadif("cust_ord.vws") return (0) END FUNCTION 'AlterSlots_2() FUNCTION FindAppt() 'enter job nr repaint off vloadif(dpath|"ordstat4.vw") order change key "[Job_Nr]" x = fentrybox(" Enter Order Nr or {Esc} to exit ",6,shopmask,"") if x = -1 return (-1) elseif x = 0 jobnr = ptstr end if ShowFittings() END FUNCTION 'FindAppt() FUNCTION ShowFittings() local d $popstr = "" repaint off vloadif(dpath|"ftr_list.vws") vloadif(dpath|"appntmnt.vws") order change physical data query execute "job_reqn.dfq" index "job_reqn.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' ³ QUERY is: [Job_Nr] = jobnr and not (deleted) ³ ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror messbox(" No appointments held on file for this job ",0,0,1) return (1) end if $dfa1 = "" $ftrappts = "" '--------------------------------------search to remove duplicate days if records > 1 data goto record first for i = 1 to records $dfa1 = left([DFA],11) x = chkstr($dfa1,$ftrappts) if x = -1 $ftrappts = $ftrappts&$dfa1 end if data goto record next end for x=strcount($ftrappts) 'message "x is:"&str(x) #ftrappts = ptval ' else $ftrappts = left([DFA],11) #ftrappts = 1 ' end if redimension ftrarray[#ftrappts] for i = 1 to #ftrappts d = days(left(group($ftrappts,i),5)) 'message "x) is:"&str(x) $day_1 = left(date2(d),6)|right(date2(d),2) $fitter = right(group($ftrappts,i),6) 'message "$fitter) is:"&str($fitter) ftrname = ReplaceHardSpace(filelookup([FTR_LIST.Fitter_Code],[FTR_LIST.Nickname],$fitter)) $popstr = $popstr&$day_1|"ÿ"|left(ftrname|"ÿÿÿÿÿÿÿÿ",8) ' HARD space ftrarray[i] = $fitter end for x = colpoplines(8,23,20,$popstr,"",1,0,14,3,14,3) 'highlight date & press {Enter} to show deliveries screen shortrestore dsa inchar vunloadif("appntmnt.vws") vunloadif("delivr_1.vw") vunloadif("ftr_list.vws") END FUNCTION ' ShowFittings() FUNCTION ShowComments() x=wraptext(8,14,12,66,clf,clb,jobdesc,"L",1,0,0) ' message "x is:"&str(x) mess5 = "Job details"|@if(slotrec=0,""," - (timeslots"&str(slotrec)|")") screen print 8 16 clf clb mess5 x = wraptext(13,14,16,66,clf,clb,ftginstr,"L",1,0,0) screen print 13 16 clf clb "Other comments (eg appointment times etc)" x = wraptext(17,14,20,66,clf,clb,ftgcomm,"L",1,0,0) screen print 17 16 clf clb "Comments re Fitting" ShowInstructions() END FUNCTION ' ShowComments() FUNCTION ReplaceCR(str1) local j r m bw l_last #addn l m = "" for j = 1 to len(str1) r = mid(str1,j,1) if r = "~" r = "" ' replace soft space end if m = m|r end for return (m) END FUNCTION ' ReplaceCR() FUNCTION GetCustDetails() ' $credit = [Credit_Status] $showdel = [PDA] cust_title = [Title] custaddr1 = [Address_1] custaddr2 = [Address_2] custcity = [City/Town] custpostcode = [Postcode] deladdr1 = [Delivery_Address_1] deladdr2 = [Delivery_Address_2] deladdr3 = [Del_City] deladdr4 = [Del_Postcode] custcode = [Customer_Code] custname = [Customer_Name] custcontact = [Contact_Name] offtel = [Office_Tel] hometel = [Home_Tel] offax = [Office_Fax] mobile = [Mobile/Other_Nr] $status = case [Credit_Status] ("A","Account") ("C","Cash only") ("D","Delayed") ("N","No deliveries!!") END FUNCTION ' GetCustDetails() FUNCTION ShowCustomer() 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 p8 df ' screen save 1 1 sch scw S_all ' clb = 13 ' clf = 10 cr1 = 8 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 if $showdel = "Y" df = clf else df = 8 end if ' screen clear box cr1 cc1 cr2 cc2 15 1 screen clear box cr1 cc1 cr2 cc2 clf clb c1 = left(custaddr1|"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ",35) c2 = left(custaddr2|"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ",35) c3 = left(custcity|"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ",35) c4 = left(custpostcode|"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ",35) screen print cr1 cc1+1 clf clb "ÿCustomer addressÿ(Acc Nr"&custcode|")ÿ" screen print cr1+1 cc1+2 clf clb c1 screen print cr1+2 cc1+2 clf clb c2 screen print cr1+3 cc1+2 clf clb c3 screen print cr1+4 cc1+2 clf clb c4 screen save cr1 cc1 cr2 cc2 custaddr ' screen clear box dr1 dc1 dr2 dc2 df clb ' screen clear box dr1 dc1 dr2 dc2 clf clb d1 = left(deladdr1|"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ",35) d2 = left(deladdr2|"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ",35) d3 = left(deladdr3|"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ",35) d4 = left(deladdr4|"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ",35) screen print dr1 dc1+1 df clb "ÿDelivery addressÿ" screen print dr1+1 dc1+2 df clb d1 screen print dr1+2 dc1+2 df clb d2 screen print dr1+3 dc1+2 df clb d3 screen print dr1+4 dc1+2 df clb d4 screen save dr1 dc1 dr2 dc2 deladdr if $showdel = "N" screen print dr2 dc1+1 df clb "ÿNot to be shown on invoiceÿ" end if screen save dr1 dc1 dr2 dc2 deladdr screen clear box pr1 pc1 pr2 pc2 clf clb 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") p8 = " press any key to continue ... " screen print pr1 pc1+1 clf clb "ÿACCOUNT STATUS:"&$status|"ÿ" screen print pr1+1 pc1+2 clf clb p1 screen print pr1+2 pc1+2 clf clb p2 screen print pr1+3 pc1+2 clf clb p3 screen print pr1+4 pc1+2 clf clb p4 screen print pr1+5 pc1+2 clf clb p5 screen print pr1+6 pc1+2 clf clb p6 screen print pr1+7 pc1+2 clf clb p7 screen print pr1+8 pc1+19 clf clb p8 inchar END FUNCTION ' ShowCustomer() FUNCTION Titles_1() local y1 y2 y3 y4 y5 y6 y7 screen clear box 22 5 23 75 0 0 no-border y5 = format("Receipts - press any key to continue","M71") y6 = format(" Date Amount Method Notes Ent'd Time Posted","L71") screen print 9 5 fgp bgp y6 screen print 22 5 fgp bgp y5 END FUNCTION ' Titles() FUNCTION BottomLine() ' y3 = format("ÿ"|chr(24)&chr(25)&"req'ns ("|str(#count)|") {I}nst's {C}ustomer {R}eceipts {F}ittings {O}rders {Esc}","M78") y3 = format(" {C}ustomer {F}ittingsÿ {I}nst's {O}rders Re{Q}'ns {R}eceipts {Esc}","M78") screen print 9 2 15 1 y3 END FUNCTION ' BottomLine() FUNCTION ShowFittings2() local $ftgstr $fname d $ftgstr = "" repaint off vloadif(dpath|"ftr_list.vws") vloadif(dpath|"appntmnt.vws") order change physical data query execute "job_reqn.dfq" index "job_reqn.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' ³ QUERY is: [Job_Nr] = jobnr and not (deleted) ³ ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror messbox(" No appointments for this job ",0,0,1) return (1) end if $dfa1 = "" $ftrappts = "" '--------------------------------------search to remove duplicate days if records > 1 data goto record first for i = 1 to records $dfa1 = left([DFA],11) x = chkstr($dfa1,$ftrappts) if x = -1 $ftrappts = $ftrappts&$dfa1 end if data goto record next end for x=strcount($ftrappts) 'message "x is:"&str(x) #ftrappts = ptval ' else $ftrappts = left([DFA],11) #ftrappts = 1 ' end if redimension ftrarray[#ftrappts] for i = 1 to #ftrappts d = days(left(group($ftrappts,i),5)) 'message "x) is:"&str(x) $day_1 = left(date2(d),6)|right(date2(d),2) $fitter = right(group($ftrappts,i),6) 'message "$fitter) is:"&str($fitter) $fname = filelookup([FTR_LIST.Fitter_Code],[FTR_LIST.Nickname],$fitter) ftrname = ReplaceHardSpace2($fname,len($fname)) $ftgstr = $ftgstr&$day_1|"ÿ"|left(ftrname|"ÿÿÿÿÿÿÿÿ",8) ' HARD space ftrarray[i] = $fitter end for while true ' x = posncolpopup(5,10,20,$ftgstr,"",1,0,clf,clb,0,7,0) 'highlight date & press {Enter} to show deliveries x = colpopup(5,10,20,$ftgstr,"",1,0,clf,clb,0,7) 'highlight date & press {Enter} to show deliveries $dateftr = ptstr if x = -1 repaint off exit while end if screen shortrestore dsa $ftrcode = ftrarray[ptval] ' ShowDeliveries() end while vunloadif("appntmnt.vws") vunloadif("delivr_1.vw") vunloadif("ftr_list.vws") END FUNCTION ' ShowFittings2() FUNCTION ShowDeliveries() progress(15,10," Please wait ... finding deliveries ",0) fgp = clf bgp = clb repaint off vloadif(dpath|"delivr_1.vw") order change key "[Job_Nr]" data query execute "job_reqn.dfq" index "sd1.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Job_Nr] = jobnr ' and ' not(deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror screen shortrestore psa messboxwait(" NO deliveries booked ",0,0,1) fgp = fgpleasing bgp = bgpleasing return (1) end if $ftrdate=date2(left($dateftr,8)) 'message "$ftrdate) is:"&str($ftrdate) $ftrdate=check_2000($ftrdate) 'message "$ftrdate) is:"&str($ftrdate) data query execute "showdel1.dfq" index "sd2.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' days([Date_Out])=days($ftrdate) ' and ' [FtrCode]=$ftrcode ' and ' not (deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror screen shortrestore psa messboxwait(" NO deliveries booked ",0,0,1) fgp = fgpleasing bgp = bgpleasing return (1) end if screen shortrestore psa y6 = format(" Deliveries not yet booked are shown in brackets ","M55") ' #thisvisit= filesum([Cost]) ' y6 = format(" Unbooked deliveries in brackets ("|currency(#thisvisit)|")","M55") screen print 6+records 26 fgp bgp y6 x = bpopdb("delivr_1",6,"","[ScrollView]","L53","[Quant_OS]","R6","[Job_Nr]",5,26,20,80,"",0) screen clear box 6+records 26 6+records 80 0 0 no-border fgp = fgpleasing bgp = bgpleasing ' x = bpopdb("delivr_1",6,"","[ScrollView]","L45","[FtrCode]","L6","[Job_Nr]",5,31,20,78,"",0) ' fgp = fgpleasing ' bgp = bgpleasing END FUNCTION ' ShowDeliveries() FUNCTION ShowOrders() local $ordstr $ordstr = "" repaint off vloadif(dpath|"variat_n.vws") order change physical data query execute "job_reqn.dfq" index "job_reqn.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' ³ QUERY is: [Job_Nr] = jobnr and not (deleted) ³ ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror messbox(" Job Nr not found ",0,0,1) return (1) end if for i = 1 to records #amount=right("ÿÿÿÿÿÿÿÿÿÿ"|currency([Amount_Gross]),10) varndes = ReplaceHardSpace2(date2([Date])&format([Reason],"L50")&#amount,70) $ordstr = $ordstr&varndes 'message "$popstr is:"&str($popstr) data goto record next end for vunloadif("variat_n.vws") ' message "$ordstr) is:"&str($ordstr) while true ' x = colpoplines(10,5,23,$ordstr,"",1,0,clf,clb,14,3) 'highlight date & press {Enter} to show deliveries x = colpoplines(10,2,23,$ordstr,"",1,0,clf,clb,14,3) 'highlight date & press {Enter} to show deliveries if x = -1 exit while end if screen shortrestore dsa end while END FUNCTION ' ShowOrders() FUNCTION ShowReceipts() local rcptdes $rcpstr $rcpstr = "" repaint off ptval=0 vloadif(dpath|"os_rcpts.vw") order change key "[Job_Nr]" data query execute "vu_cash" index "#1stcash.idx" ' ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» ' [Job_Nr] = jobnr ' ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ if cerror messbox(" No cash received for this order ",0,0,1) vunloadif("os_rcpts.vw") return (0) end if for i = 1 to records #amount=right("ÿÿÿÿÿÿÿÿÿÿÿÿ"|currency([Amount_Received]),12) rcptdes = ReplaceHardSpace(date2([Date_Of_Receipt])&format([Method_Of_Payment],"L6")&[Entered_By]&format([Authorisation],"L20")&#amount) $rcpstr = $rcpstr&rcptdes 'message "$popstr is:"&str($popstr) data goto record next end for vunloadif("os_rcpts.vw") x = colpoplines(10,5,20,$rcpstr,"",1,0,clf,clb,14,3) 'highlight date & press {Enter} to show deliveries screen shortrestore dsa inchar END FUNCTION ' ShowReceipts() FUNCTION NavReqns() local x psmode pd pq ReqnLines() screen save scrheight 1 scrheight scrwidth bot smartpeek $_spndmes psmode if psmode = 1 smartpoke $_spndmes 0 end if NavMess() while TRUE x = inchar if x = {Down} data goto record next NavMess() elseif x = {Up} data goto record previous NavMess() elseif x = {PgDn} data goto page next NavMess() elseif x = {PgUp} data goto page previous NavMess() elseif x = {^End} data goto record last NavMess() elseif x = {^Home} data goto record first NavMess() else exit while end if end while if psmode = 1 smartpoke $_spndmes 1 end if return (x) END FUNCTION 'Navreqns() FUNCTION NavMess() local col1 pd pq pr psc psn psr psp y2a pq1 if [Item_Type] = "B" or [Item_Type]="W" or [Item_Type]="J" or [Item_Type]="T" or [Item_Type]="O" pr = [Date_Allocated] 'message "pr is:"&date2(pr) $refnr = [Reference_Nr] 'message "$refnr is:"&str($refnr) error off while true pd = filelookup([purchord.Order_Nr],[purchord.Date_Ordered],$refnr) if cerror col1 = 12 y2 = format("Order not held in Purchase Order file ","M71") y2a = format(" ","M71") 'message "len(y2)) is:"&str(len(y2)) exit while else pq = filelookup([purchord.Order_Nr],[purchord.Delivery_Quoted],$refnr) pq1 = @if(pq=null,"N/Q",pq) 'message "pq1 is:"&str(pq1) psc = filelookup([purchord.Order_Nr],[purchord.Supplier_Code],$refnr) psr = filelookup([purchord.Order_Nr],[purchord.Order_Reference],$refnr) psn = filelookup([supplier.Supplier_Code],[supplier.Name],psc) psp = filelookup([supplier.Supplier_Code],[supplier.Telephone],psc) col1 = 1 if value(pr)=0 y2 = format("Ordered on"&date2(pd)&"- for delivery:"&pq1,"M78") y2a = format(left("(from:"&psn&"(ref:"|psr|")-"&psp|")",78),"M78") 'message "len(y2)) is:"&str(len(y2)) else y2 = format(left("Order received on"&date2(pr)|"ÿ",71),"M78") y2a = format(left("(from:"&psn&"(ref:"|psr|")-"&psp|")",78),"M78") 'message "len(y2)) is:"&str(len(y2)) end if end if exit while end while screen print 22 2 15 col1 y2 screen print 23 2 15 col1 y2a else y2 = format("ÿ","M78") y2a = format(" ","M78") screen print 22 2 15 col1 y2 screen print 23 2 15 col1 y2a end if END FUNCTION 'NavMess() FUNCTION ReqnLines() y3 = format("ÿ"|chr(24)&chr(25)&"req'ns ("|str(#count)|") {Esc} when finished ","M78") screen print 9 2 15 1 y3 END FUNCTION ' ReqnLines() FUNCTION ShowAllReqs() local y2 y1 y4 $desc $reqstr vloadif(dpath|"allreqn2.vw") order change key "[JobNr]" data query execute "all_reqn.dfq" index "all_req1.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' ³ QUERY is: [Job_Nr] = jobnr ³ ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror x = remove("all_reqn.idx") ' create temp index for allocation x = makeidx("requsn","all_reqn.idx","0",1) if x = -1 message "makeidx() failed" end if y4 = format("ÿNo requisitions entered for this job ","M71") screen print 10 5 15 12 y4 else ' order by ListOrder & prodMRC order sort now dictionary "all_reqn.idx" fields "[Lst_Stck;Product_MRC]" ascending data goto record first for i = 1 to records $desc = ReplaceHardSpace2([DesColor],len([DesColor])) 'message "$desc is:"&str($desc) $reqstr = $reqstr&$desc ' ftrarray[i] = $fitter data goto record next end for vunloadif("allreqn2.vw") x = colpopup(8,5,20,$reqstr,"",1,0,clf,clb,0,7) 'highlight date & press {Enter} to show deliveries if x = -1 return (-1) end if end if END FUNCTION ' ShowAllReqs() FUNCTION SetupDetails() screen save 1 1 sch scw S_all ' progress(fgp,bgp," Checking for existing order ",0) data find "[Job_Nr]" equal jobnr options "gw" if cerror ' if none - then return messbox(" Job not found ",1,0,0) return (-1) else jobdesc = [Description] ftginstr = [Instructions] ftgcomm = [Fitting_Comment] jobdesc = @if(len(jobdesc)=0,"Not known",jobdesc) ftginstr = @if(len(ftginstr)=0,"Not known",ftginstr) ftgcomm = @if(len(ftgcomm)=0,"Not known",ftgcomm) slotrec = [Appt_Slots] $ordstat = [Order_Status] $invoice = [Completed] $invnr = [Inv_Nr] $invdate = [Invoice_Date] end if $chstr1 = "Customer Fittings Instructions Orders Requisitions Receipts Worksheet/Returns" $chstr2 = "Customer Fittings Instructions Orders Requisitions Receipts Worksheet" ' message "base is:"&str(base) ' message "areas is:"&str(areas) while true screen shortrestore S_all if areas!"W" x=colpopup(8,31,20,$chstr1,"",1,0,clf,clb,0,7) 'highlight date & press {Enter} to show deliveries else x=colpopup(8,31,20,$chstr2,"",1,0,clf,clb,0,7) 'highlight date & press {Enter} to show deliveries end if if x = -1 return (-1) end if if ptstr = "Instructions" ShowComments() ' {I}nstructions elseif ptstr = "Receipts" #1stbalance = 0 ShowReceipts() elseif ptstr = "Customer" vloadif(dpath|"ordstat4.vw") order change key "[Job_Nr]" data find "[Job_Nr]" equal jobnr options "" GetCustDetails() vunloadif("ordstat4.vw") ShowCustomer() elseif ptstr = "Fittings" x=ShowFittings2() elseif ptstr = "Orders" x=ShowOrders() inchar elseif ptstr = "Requisitions" x = ShowAllReqs() elseif ptstr = "Worksheet" x = ShowFtrsWkSht() elseif ptstr = "Worksheet/Returns" x = FtrsWkSht() end if end while END FUNCTION ' SetupDetails() FUNCTION ShowInstructions() local mess2 if $ordstat <> "L" and $ordstat <> "D" fgp = clf bgp = clb x = messline(" Update Instructions? (y/n) ",1,1,1,21,14,53) fgp = fgpleasing bgp = bgpleasing if x = 0 if ptstr == "y" x = EnterInstructions() ' return 0 - success return (1) else ' repaint & restore top of screen repaint off return (1) end if end if else messboxwait(" Instructions cannot be altered - already passed/delivered ",0,0,1) return (1) end if END FUNCTION ' ShowInstructions() FUNCTION EnterInstructions() local l #lenareas #startc #startr error off while true y = format("Press F10 to finish","M53") screen print 21 14 7 1 y x=wraptext(8,14,12,66,7,1,jobdesc,"L",1,0,0) ' message "x is:"&str(x) mess5 = "Job details"|@if(slotrec=0,""," - (timeslots"&str(slotrec)|")") screen print 8 16 7 1 mess5 x = wraptext(17,14,20,66,7,1,ftgcomm,"L",1,0,0) screen print 17 16 7 1 "Comments re Fitting" while true #lenareas = len(ftginstr) 'message "#lenareas) is:"&str(#lenareas) #startc = mod(#lenareas,50) #startr = int(#lenareas/50)+1 screen editor 13 14 16 66 15 1 "Other comments (eg appointment times etc)" VARIABLE ftginstr ftginstr\ MAX 2 50 START #startr #startc OPTIONS "" 0 0 1 RW_MODE smartpeek $_lastkey z if z <> {F10} messbox(" Must use {F10} to save record!! ",0,0,1) continue while else exit while end if end while x = wraptext(13,14,16,66,7,1,ftginstr,"L",1,0,0) screen print 13 16 7 1 "Other comments (eg appointment times etc)" while true #lenareas = len(ftgcomm) ' message "#lenareas) is:"&str(#lenareas) #startc = mod(#lenareas,50) #startr = int(#lenareas/50)+1 screen editor 17 14 20 66 15 1 "Comments re Fitting" VARIABLE ftgcomm ftgcomm\ MAX 2 50 START #startr #startc OPTIONS "" 0 0 1 RW_MODE smartpeek $_lastkey z if z <> {F10} messbox(" Must use {F10} to save record!! ",0,0,1) continue while else exit while end if end while messline(" Confirm correct and continue? (y/n) ",1,1,1,22,14,53) if ptstr == "y" if len(ftginstr) = 0 messbox(" Must enter instructions ",0,0,1) continue while else WriteDetails() vunloadif("ordstat4.vw") return (0) end if else continue while end if end while END FUNCTION ' EnterInstructions() FUNCTION WriteDetails() ' write customer & job details to CUSENT3B jobdesc = ReplaceCR(jobdesc) ftginstr = ReplaceCR(ftginstr) ftgcomm = ReplaceCR(ftgcomm) lock-record [Description] = jobdesc [Instructions] = ftginstr [Fitting_Comment] = ftgcomm [Last_Update] = today [Updated_By] = userid write-record END FUNCTION ' WriteDetails() FUNCTION Show() ' local y1 y2 y3 y4 y5 y6 vloadif(dpath|"shwappt5.vw") ' message "jobnr is:"&str(jobnr) repaint on repaint ' y1 = format("ÿ{A}pp'ts -ÿ{D}etails - {F}ind appt - {O}rder Status - Deli{V}eries - {Esc}ÿ","M99") y1 = format("{A}pp'ts {D}etails {F}ind appt {O}rderStatus Deli{V}eries {M}easuring {Esc}ÿ","M80") screen print 29 16 fgp bgp y1 y2 = format(" Reservationÿ","M14") screen print 30 16 14 7 y2 y3 = format(" Not ready for delivery ","M24") screen print 30 30 4 7 y3 y4 = format(" Ready for delivery ","M20") screen print 30 54 10 7 y4 y5 = format("ÿWarrantyÿ","M10") screen print 30 74 13 7 y5 y6 = format(" Assisting ","M12") screen print 30 84 11 7 y6 END FUNCTION ' Show() FUNCTION Navigate() local x j k l nextcell sortblock c ll dm start_t col = 4 start_t = seconds(now) quiet on while TRUE 'message "col is:"&str(col) k = nextkey if k<>0 inchar 'message "k is:"&str(k) quiet on if k = {Up} if record = 1 beep continue while end if data goto record previous if indirect("[A"|str(col-3)|"]") = "ÛÛÛÛÛÛÛÛ" data goto record previous end if ShowMin() start_t = seconds(now) elseif k = {Down} if record = records beep continue while end if data goto record next if indirect("[A"|str(col-3)|"]") = "ÛÛÛÛÛÛÛÛ" data goto record next end if ShowMin() start_t = seconds(now) elseif k = {Right} if col = 10 ' check that cursor does not go to col 11 beep continue while end if col = col + 1 suspendone keys Right,F8 ShowMin() start_t = seconds(now) elseif k = {Left} if col = 4 ' check that cursor does not go to col 3 beep continue while end if suspendone keys Left,F8 col = col - 1 ShowMin() start_t = seconds(now) elseif k = {PgDn} j = record ' find present pos'n j = j + 17 ' if j > records data goto record last else data goto record record-number j end if if indirect("[A"|str(col-3)|"]") = "ÛÛÛÛÛÛÛÛ" data goto record next end if ShowMin() start_t = seconds(now) elseif k = {PgUp} j = record ' find present pos'n j = j - 17 ' go up 17 rows if j < 1 ' ensure it does not goes above row 1 data goto record first else data goto record record-number j end if if indirect("[A"|str(col-3)|"]") = "ÛÛÛÛÛÛÛÛ" data goto record previous end if ShowMin() start_t = seconds(now) elseif k = {^End} data goto record last ShowMin() start_t = seconds(now) elseif k = {^Home} data goto record first ShowMin() start_t = seconds(now) elseif k = {d} or k = {D} ' show job details sd=ShowDetails() ShowMin() start_t=seconds(now) elseif k = {a} or k = {A} ' APPT'S sub-menu linenr = 0 ftgdate = [Date] if days(ftgdate) = days(today) ' message "4552/ userid is:"&str(userid) ' message "$permit is:"&str($permit) if userid <> $permit messbox(" Cannot alter today's appointments! ",0,0,1) continue while end if ApptsMenu() Show() ' elseif days(ftgdate) < days(today) else ApptsMenu() Show() end if start_t = seconds(now) elseif k = {o} or k = {O} ' Order Status jobnr = indirect("[A"|str(col-3)|"]") 'message "jobnr) is:"&str(jobnr) if asc(mid(jobnr,2,1))>57 or asc(mid(jobnr,2,1))<48 continue while end if $dayftr=[DayFitter] ' message "$dayftr is:"&str($dayftr) $ftrdate=date2(left($dayftr,5)) ' message "$ftrdate is:"&str($ftrdate) $ftrcode=right($dayftr,6) ' message "$ftrcode is:"&str($ftrcode) repaint off k=remove("all_req1.idx") vloadif(dpath|"ordstat4.vw") x = SetupDetails() Show() start_t = seconds(now) elseif k = {f} or k = {F} ' find appt FindAppt() Show() start_t = seconds(now) elseif k = {m} or k = {M} ' tfr to Estimating Diary Background() repaint off file unload all execute "measopts.rf3" in-memory elseif k = {v} or k = {V} ' Deliveries sub-menu jobnr = indirect("[A"|str(col-3)|"]") ' message "jobnr) is:"&str(jobnr) $dfa = [DayFitter]|str(col-3) ' message "$dfa is:"&str($dfa) ftgdate = [Date] ' message "ftgdate is:"&date2(ftgdate) if days(ftgdate) < days(today) ' i.e. in the past vo = 1 dm = 1 else vo = 0 dm = 0 end if FindFirstJobNr() $ordstat = indirect("[B"|str(col-3)|"]") 'message "$ordstat is:"&str($ordstat) if $ordstat = blank continue while end if if $ordstat = "P" or $ordstat = "D" or $ordstat = "O" $ftrcode = right([DayFitter],6) jobnr=indirect("[A"|str(col-3)|"]") ' message "jobnr) is:"&str(jobnr) DeliverMenu(dm) 'from L3144 else messbox(" Cannot arrange deliveries - check Order Status ",0,0,1) end if start_t = seconds(now) elseif k = {Esc} return (0) end if elseif seconds(now)-start_t>#timeout return (0) end if end while END FUNCTION 'Navigate FUNCTION Nav_Move() 'select place to move appts to & press F10 ' check sufficient spare places to the right; if sufficient book appts ' with jobnr ELSE error INSUFFICIENT available - re-navigate local x j k l nextcell sortblock c ll dm cn quiet on repaint on repaint ShowMove() while TRUE 'message "col is:"&str(col) quiet on x = inchar 'message "x) is:"&str(x) if x = {Up} if record = 1 beep continue while end if data goto record previous if indirect("[A"|str(col-3)|"]") = "ÛÛÛÛÛÛÛÛ" data goto record previous end if ShowMove() elseif x = {Down} if record = records beep continue while end if data goto record next if indirect("[A"|str(col-3)|"]") = "ÛÛÛÛÛÛÛÛ" data goto record next end if ShowMove() elseif x = {Right} if col = 10 ' check that cursor does not go to col 11 beep continue while end if col = col + 1 suspendone keys Right,F8 ShowMove() elseif x = {Left} if col = 4 ' check that cursor does not go to col 3 beep continue while end if suspendone keys Left,F8 col = col - 1 ShowMove() elseif x = {PgDn} j = record ' find present pos'n j = j + 17 ' ' j = j + #int if j > records data goto record last else data goto record record-number j end if if indirect("[A"|str(col-3)|"]") = "ÛÛÛÛÛÛÛÛ" data goto record next end if ShowMove() elseif x = {PgUp} j = record ' find present pos'n j = j - 17 ' go up 17 rows ' j = j - #int if j < 1 ' ensure it does not goes above row 1 data goto record first else data goto record record-number j end if if indirect("[A"|str(col-3)|"]") = "ÛÛÛÛÛÛÛÛ" data goto record previous end if ShowMove() elseif x = {^End} data goto record last ShowMove() elseif x = {^Home} data goto record first ShowMove() elseif x = {Enter} ' select place to move to cn = CheckNewPlace() if cn = 0 return (0) else repaint on repaint continue while end if elseif x = {Esc} ' abandon? messbox(" Abandon moving appts? (y/n) ",1,1,1) if ptstr == "y" return (-1) else continue while end if end if end while END FUNCTION ' Nav_Move() FUNCTION CheckNewPlace() local es j tj ' check sufficient spare places to the right; if sufficient book appts ' with jobnr ELSE error INSUFFICIENT available - re-navigate repaint off if col+nrslots > 11 messboxwait(" Cannot start here - insufficient appts available ",0,0,1) return (1) end if es = indirect("[A"|str(col-3)|"]") ' if es !! "None" messboxwait(" Cannot start here - appt already used ",0,0,1) return (1) end if repaint off col = col + 1 suspendone keys Right,F8 for i = 2 to nrslots es = indirect("[A"|str(col-3)|"]") ' message "col is:"&str(col)' message "tj is:"&str(tj) if es !! "None" messboxwait(" Insufficient slots available for move ",0,0,1) for j = 1 to i-1 col = col - 1 suspendone keys Left,F8 end for return (1) end if col = col + 1 suspendone keys Right,F8 end for for j = 1 to nrslots col = col - 1 suspendone keys Left,F8 end for return (0) END FUNCTION ' CheckNewPlace() FUNCTION DeliveriesOK() vloadif(dpath|"shwappt3.vw") data query execute "os_dely.dfq" index "os_dely.idx" ' find all records with same jobnr & ftgdate ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Job_Nr] = jobnr ' and ' [Date]=ftgdate ' and ' not(deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror order change physical return (1) else if records <= nrslots order change physical return (1) else order change physical return (0) end if end if END FUNCTION ' DeliveriesOK() FUNCTION ShowMove() y1 = format("Use cursor to navigate to required and then press","M80") screen print 21 1 fgp bgp y1 y2 = format("ÿ{Enter} to move to this appt - {F10} to finish - {Esc} to abandonÿ","M80") screen print 22 1 fgp bgp y2 END FUNCTION ' ShowMove() FUNCTION BookMove() $dfa = [DayFitter]|str(col-3) 'message "$dfa is:"&str($dfa) #appt = col - 3 'message "#appt is:"&str(#appt) ftrname = [Nickname] 'message "ftrname is:"&str(ftrname) $ftrcode= right([DayFitter],6) 'message "$ftrcode is:"&str($ftrcode) $dow = [DOW] 'message "$dow is:"&str($dow) repaint off vloadif(dpath|"bookappt.vw") order change key "[DFA]" data find "[DFA]" equal $dfa options "" if cerror ' if none - then return x = messbox(" $dfa not found ",0,0,1) Show() return (0) ' NOT booked end if $stat = "P" lock-record ' Book appt on screen [Job_Nr] = jobnr ' [DelAddr&Code] = left(deladdr1|","&delpostcode,30) [Entered_By] = userid [Date_Altered] = today [Time] = now [N_name] = ftrname [Status] = $stat write-record repaint off vloadif(dpath|"shwappt5.vw") lock-record dbput("[A"|str(col-3)|"]",jobnr) dbput("[B"|str(col-3)|"]",$stat) write-record return (1) END FUNCTION ' BookMove() FUNCTION MoveAppt() local from_rec from_col tj h sl_mask cod cag do nm m bm da #max jobnr = indirect("[A"|str(col-3)|"]") 'message "jobnr) is:"&str(jobnr) if asc(mid(jobnr,2,1))>57 or asc(mid(jobnr,2,1))<48 return (-1) ' end if $ordstat = indirect("[B"|str(col-3)|"]") 'message "$ordstat is:"&str($ordstat) x=messline(" Is cursor over earliest appt to move? (y/n) ",1,1,0,21,1,78) if ptstr == "n" return (-1) end if 'find posn of cursor from_rec = record 'message "record is:"&str(record) from_col = col 'message "col is:"&str(col) x=messline(" Move all deliveries for that day as well? (y/n) ",1,1,0,21,5,70) if ptstr == "n" $movedely = 1 else $movedely = 0 end if jobnr = indirect("[A"|str(col-3)|"]") 'message "jobnr) is:"&str(jobnr) sl_mask = case col (4,"[1234567]")(5,"[123456]")(6,"[12345]")(7,"[1234]")(8,"[123]")(9,"[12]")(10,"[1]") 'message "sl_mask is:"&str(sl_mask) #max = 11-col 'message "#max is:"&str(#max) repaint off while true while true x = entryline(" Enter Nr of slots to move (max"&str(#max)|") ",2,sl_mask,"",21,1,80) if x = -1 return (-1) end if if ptstr = "" continue while end if nrslots = val(ptstr) exit while end while if nrslots>1 for i = 1 to nrslots-1 tj = indirect("[A"|str(col-3)|"]") ' message "col is:"&str(col)' message "tj is:"&str(tj) if tj !! jobnr messboxwait(" There are not"&str(nrslots)&"contiguous appts to move ",0,0,1) for h = 1 to nrslots-1 col = col - 1 suspendone keys Left,F8 end for continue while end if col = col + 1 suspendone keys Right,F8 end for end if exit while end while if nrslots>1 for h = 1 to nrslots-1 col = col - 1 suspendone keys Left,F8 end for end if if $movedely = 1 'check appts on that day exceed nrslots; if NOT then deliveries must be cancelled do=DeliveriesOK() 'message "do is:"&str(do) if do = 1 'appts<=nrslots - MUST delete messbox(" Deliveries must be moved with appts - continue? (y/n) ",1,0,1) if ptstr == "y" $movedely = 0 else return (-1) 'abandon end if end if end if vloadif(dpath|"shwappt5.vw") '?all checks made? nm=Nav_Move() 'message "nm is:"&str(nm) if nm = -1 return (-1) end if for m = 1 to nrslots bm=BookMove() if m = nrslots exit for end if col = col + 1 suspendone keys Right,F8 end for ' message "cancel original appts" repaint off data goto record record-number from_rec ' move back if from_col>col for m = 1 to abs(col-from_col) col = col + 1 suspendone keys Right,F8 end for else for m = 1 to abs(col-from_col) col = col - 1 suspendone keys Left,F8 end for end if repaint off for m = 1 to nrslots $dfa = [DayFitter]|str(col-3) 'message "$dfa is:"&str($dfa) da=DeleteMoveFrom() ' vloadif(dpath|"shwappt5.vw") if m = nrslots exit for end if col = col + 1 suspendone keys Right,F8 end for return (0) END FUNCTION ' MoveAppt() FUNCTION DeleteMoveFrom() local nextnr repaint off vloadif(dpath|"bookappt.vw") order change key "[DFA]" data find "[DFA]" equal $dfa options "F" if cerror ' if none - then return x = messbox(" Job Nr not found ",1,0,0) return (0) end if lock-record [Job_Nr] = "None" [DelAddr&Code] = "" [Entered_By] = userid [Date_Altered] = today [Time] = now [N_name] = "" [Status] = "P" write-record repaint off vloadif(dpath|"shwappt5.vw") lock-record dbput("[A"|str(col-3)|"]","None") dbput("[B"|str(col-3)|"]","") write-record END FUNCTION ' DeleteMoveFrom() FUNCTION Conv_Resvn() local cr cb cb = CheckBooked() if cb = -1 return (-1) end if ftgdate = [Date] if days(ftgdate) = days(today) return (-1) end if cr = Conversion() END FUNCTION ' Conv_Resvn() FUNCTION Conversion() local $mess $chk $refnr ra ba $chk = mid(indirect("[A"|str(col-3)|"]"),2,1) if chkstr($chk,"1 2 3 4 5 6 7 8 9 0") = 0 messbox(" Not a Reservationÿ",0,0,1) return (-1) end if repaint off $dfa = [DayFitter]|str(col-3) 'message "$dfa is:"&str($dfa) if indirect("[A"|str(col-3)|"]") = "ABSENT" return (-1) elseif indirect("[A"|str(col-3)|"]") = "ASSIST" return (-1) elseif indirect("[A"|str(col-3)|"]") = "None" return (-1) end if jobnr = indirect("[A"|str(col-3)|"]") 'message "L5132/ jobnr is:"&str(jobnr) #appt = col - 3 ftrname = [Nickname] $dow = [DOW] $ftrcode= right([DayFitter],6) 'message "$ftrcode) is:"&str($ftrcode) vloadif(dpath|"appntmnt.vws") $mess = filelookup([appntmnt.DFA],[appntmnt.DelAddr&Code],$dfa) $refnr = left($mess,6) 'message "L5006 $refnr is:"&str($refnr) '############### $cust = "`"|right($mess,len($mess)-7)|"'" ' $user = jobnr if $menu = "offc" or $menu = "shop" vloadif("oldpurch.vws") resvdat = filelookup([author],[Base],$user) vunloadif("oldpurch.vws") vloadif(dpath|"appntmnt.vws") x = ChkAreas(resvdat,areas) if x = -1 '0=found in string; -1= NOT found messbox(" You can only cancel your own shop's reservations! Contact HO (ref 5) ",0,0,1) return (-1) end if end if while true x = entryline(" Enter Reservation ref for"&$cust,6,resref,"",22,1,80) if x = -1 return (-1) ' NOT booked else if ptstr <> $refnr x = messline(" Incorrect reference! ",0,0,1,22,1,80) continue while else order change key "[DFA]" 'message "$dfa is:"&str($dfa) data find "[DFA]" equal $dfa options "" if cerror ' if none - then return x = messbox(" Job Nr not found ",0,0,1) return (0) ' NOT booked end if repaint off x = FindJobNr(1) if x = -1 return (-1) 'Esc/NULL return elseif x = 1 return (-1) 'Esc/NULL return end if if #slotsrem = 0 messbox(" No more appointments to book ",0,0,1) return (-1) 'NULL return end if if Check4Appts() = 1 ' NULL return x = messboxwait(" No Appointment slots entered - enter these first ",0,0,1) return (-1) end if vloadif(dpath|"shwappt5.vw") while true ' $appth = case #appt (1,"1st")(2,"2nd")(3,"3rd") else str(#appt)|"th" $appth = case #appt (1,"1st")(2,"2nd")(3,"3rd") else str(#appt)|"th" y1 = format("Now booking appt's for"&"-"&title1,"M110") screen print 1 1 fgp bgp y1 $dow=upper(left(dayname(ftgdate),3)) x=messbox(" Book as"&ftrname|"'s"&$appth&"app't on"&$dow&upper(left(date1(ftgdate),6))|"? Y/N ("|str(#slotsrem)&"slots remaining) ",1,1,1) if ptstr == "Y" ' Book appt repaint off vloadif(dpath|"bookappt.vw") order change key "[DFA]" ' data find "[DFA]" equal $dfa options "" if cerror ' if none - then return x = messbox(" Job Nr not found ",0,0,1) Show() return (0) ' NOT booked else if left([DelAddr&Code],6)<>$refnr x = messboxwait(" Not this reservation ",0,0,1) Show() return (0) ' NOT booked end if end if lock-record ' [Job_Nr] = jobnr [DelAddr&Code] = "Converted by"&userid&"on"&date2(today) [Entered_By] = userid [Date_Altered] = today [Time] = now [N_name] = ftrname [Status] = "P" ' [Status] = $ordstat write-record #slotsrem = #slotsrem - 1 repaint off vloadif(dpath|"find_job.vw") lock-record ' update CUST_ORD record [Slots_Rem] = #slotsrem write-record repaint off vloadif(dpath|"shwappt5.vw") x = LookLeft(jobnr) if x = 0 'message "Cell to left is same jobnr" $ordstat = "C" else $ordstat = "P" end if lock-record dbput("[A"|str(col-3)|"]",jobnr) dbput("[B"|str(col-3)|"]",$ordstat) write-record if #slotsrem = 0 return (1) ' ALL booked elseif #slotsrem = #apptslots return (0) ' NONE booked else if col = 10 return (-1) 'Null return end if mr = MoveRight() if mr = 1 return (1) end if $dfa = [DayFitter]|str(col-3) 'message "$dfa is:"&str($dfa) continue while end if elseif ptstr == "N" ' do NOT book appt repaint on repaint if #slotsrem = 0 return (1) ' ALL booked elseif #slotsrem = #apptslots return (0) ' NONE booked else return (2) ' SOME booked end if end if end while if z = 1 ' ALL appts booked messbox(" ALL appointments booked!! ",0,1,1) return (1) elseif z = 0 ' NONE booked messboxwait(" NO appointments booked ",0,0,1) repaint off while true vloadif(dpath|"entappt4.vw") order change key "[Job_Nr]" data query execute "job_reqn.dfq" index "jobappt1.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Job_Nr] = jobnr ' and ' not(deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror return (0) end if data goto record first for i = 1 to records ' mark requsn's with ftgdate lock-record [Expect_Fitting_Date] = blank [Ftr_Code] = "" write-record data goto record next end for exit while end while vunloadif("entappt4.vw") return (0) elseif z = 2 ' SOME booked messboxwait(" Not All appointments are booked! ",0,0,1) messbox(" Alter number of appointments? (y/n) ",1,1,1) if ptstr == "y" AlterApptSlots() return (2) else messboxwait(" Book remaining appointments!! ",0,0,1) return (-1) end if elseif z = -1 ' NULL return return (-1) end if exit while end if end if end while mr = MoveRight() return (0) END FUNCTION ' Conversion() FUNCTION ChkAreas(r,a) ' '0=found in string; -1= NOT found local m n ' message "r is:"&str(r) ' message "a is:"&str(a) n=len(a) ' message "n is:"&str(n) for i = 1 to n m=mid(a,i,1) ' message "m is:"&str(m) if m=r return (0) end if end for return (-1) END FUNCTION ' ChkAreas() ' FUNCTION DeleteAppt() ' local nextnr ' repaint off ' vloadif(dpath|"bookappt.vw") ' if lr=0 ' order change key "[DFA]" ' data find "[DFA]" equal $dfa options "F" ' if cerror ' if none - then return ' x = messbox(" Job Nr not found ",1,0,0) ' return (0) ' end if ' lr=1 ' elseif lr=1 ' data goto record next ' nextnr = [Job_Nr] ' if nextnr <> jobnr ' return (2) ' NONE booked/ALL appts deleted ' end if ' end if ' lock-record ' [Job_Nr] = "None" ' [DelAddr&Code] = "" ' [Entered_By] = userid ' [Date_Altered] = today ' [Time] = now ' [N_name] = "" ' [Status] = "" ' write-record ' ' repaint off ' vloadif(dpath|"shwappt5.vw") ' lock-record ' dbput("[A"|str(col-3)|"]","None") ' dbput("[B"|str(col-3)|"]","") ' write-record ' ' #slotsrem = #slotsrem + 1 ' repaint off ' vloadif(dpath|"find_job.vw") ' lock-record ' update CUST_ORD record ' [Slots_Rem] = #slotsrem ' write-record ' ' repaint off ' vloadif(dpath|"shwappt5.vw") ' ' if #slotsrem = #apptslots ' NONE booked/ALL appts deleted ' repaint off ' vloadif(dpath|"bookappt.vw") ' order change physical ' data query execute "job_reqn.dfq" index "job_reqn.idx" ' ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' ' [Job_Nr] = jobnr ' ' and ' ' not(deleted) ' ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ' if cerror ' latestftg = blank ' else ' latestftg = date2(filemax([Date])) ' end if ' vloadif(dpath|"find_job.vw") ' lock-record ' update CUST_ORD record ' [Fitting_Date] = latestftg ' [Ftr_Code] = "" ' write-record ' return (2) ' end if ' ' if #appt < 7 ' #appt = #appt + 1 ' if col = 10 ' check that cursor does not go to col 11 ' beep ' return (1) ' end if ' col = col + 1 ' suspendone ' keys Right,F8 ' else ' ' message "Some ftgs remaining??" ' return (1) ' end if ' ' message "lr is:"&str(lr) ' return (1) ' END FUNCTION ' DeleteAppt() ' ' ' FUNCTION QueryInvoice() ' local $complete ' message "jobnr is:"&str(jobnr) ' 'find Completion status ' vloadif(dpath|"checkapp.vw") ' $complete = [Completed] ' message "$complete is:"&str($complete) ' message "ftgdate is:"&date2(ftgdate) ' 'are there any ftgs on this day? ' vloadif(dpath|"bookappt.vw") ' order change key "[Job_Nr]" ' data query execute "job_reqn" index "jobappts" ' if cerror ' else ' if filemax([Date])=today ' t = 2 ' ' while true ' $date2binv = date2(days(today)+t) ' message "$date2binv is:"&str($date2binv) ' case dayname($date2binv) ' ' when "Monday" ' ' when "Tuesday" ' ' exit while ' ' when "Wednesday" ' ' exit while ' ' when "Thursday" ' ' exit while ' when "Friday" ' $date2binv = date2(days(today)+t+2) ' ' exit while ' when "Saturday" ' $date2binv = date2(days(today)+t+1) ' ' exit while ' ' when "Sunday" ' ' exit while ' end case ' ' end while ' message "Today is last ftg" ' ' messbox(" Last booked fitting is today - invoice on"&date2(days(today)+2)|"? (y/n) ",1,1,1) ' messbox(" This Last booked fitting is today - invoice on"&date2($date2binv)|"? (y/n) ",1,1,1) ' if ptstr == "y" ' message "Alter To_Invoice to today+2" ' ' [DateTB_Inv] ' ' return (-1) ' else ' 'enter invoice date - not before $date2binv ' while true ' x = fentrybox(" Enter date for invoicing ",10,"##\/##\/####",$date2binv) ' if x = -1 ' continue while ' end if ' if ptstr == "Y" ' exit while ' else ' continue while ' end if ' end while ' ' end if ' else ' ' continue while ' end if ' end if ' ' ' if [Date] ' 'N - return(1) ' 'Y - is this the latest ftg date? ' ' Y - Do you want to invoice this order? ' ' Y - check for undelivered req'ns and slots; if none mark as Complete ELSE query ' ' N - why not? reason req'd before continuing (except Warehouse) - write to Exception messages ' ' N - if marked as Completed confirm invoice to be printed on dd/mm/yy ELSE ' ' change to incomplete ' ' END FUNCTION ' QueryInvoice() FUNCTION LookLeft($job) local leftjob ' message "$job is:"&str($job) repaint off if col = 4 return (1) end if leftjob = indirect("[A"|str(col-4)|"]") 'message "leftjob is:"&str(leftjob) if leftjob = $job if "[B"|str(col-3)|"]" <> "C" if "[B"|str(col-3)|"]" <> "P" vloadif(dpath|"bookappt.vw") order change key "[DFA]" data find "[DFA]" equal $dfa options "" if cerror ' if none - then return x = messbox(" $dfa not found ",0,0,1) Show() return (0) ' NOT booked end if lock-record [Status] = "C" write-record vloadif(dpath|"shwappt5.vw") lock-record dbput("[B"|str(col-3)|"]","C") write-record return (0) end if end if else return (1) end if END FUNCTION ' LookLeft() FUNCTION CheckFtrProcessed() 'if processed return 1 else 0 ' look up GOODSOUT.VWS file to see if Fitting has been processed (ie entry in [Document]) 'needed - ftrcode $ftrcode = right([DayFitter],6) 'message "$ftrcode is:"&str($ftrcode) END FUNCTION ' CheckFtrProcessed() FUNCTION PrintJobSheet() 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 & fitter vloadif(dpath|"lststk_G.vw") order change index "todays1.idx" data query execute "jobsheet.dfq" index "job_reqn.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Job_Nr] = jobnr ' and ' [Itemtype] <> "O" ' and ' not(deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror messboxwait(" No goods to despatch for job"&jobnr|" ",0,0,1) return (0) end if order sort execute dictionary "lst_stck.dfs" index "lst_stck" data goto record first $ftrs = [FtrCode] data goto record next for i = 2 to records 'create text string of Job Nrs x = chkstr([FtrCode],$ftrs) if x = -1 $ftrs = $ftrs&[FtrCode] end if data goto record next end for ' message "472\$ftrs is:"&str($ftrs) x=strcount($ftrs) 'message "x is:"&str(x) #ftrs = ptval 'message "#ftrs is:"&str(#ftrs) for i = 1 to #ftrs ftrcode = group($ftrs,i) ' vloadif(dpath|"ftr_list.vws") ftrname = filelookup([Fitter_Code],[Nickname],ftrcode) vloadif(dpath|"lststk_G.vw") data query execute "ftrsheet.dfq" index "ftrsheet.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [FtrCode] = ftrcode ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ' sort by LstOrder order sort execute dictionary "lst_stck" index "lststck1" ' remove(X_path|"X_jobwks.*") ' data query execute "not_del.dfq" data-file X_path|"X_jobwks" fields "[Fitting_Date|Width]" ' vunloadif("X_jobwks.vws") ' ClearHardSpaces() ' _SWIP_Crystal(Xreppath|"X_jobwks","P",0,1,"") ' vloadif(dpath|"lststk_G.vw") ' vloadif(dpath|"lststk_a.vw") ' vloadif(dpath|"ftrwks_X.vw") ' PrintReport("ftrwks_F.dfr","Job Worksheet",p3,p4,p5,p6) ' return (0) p1 = "ftrwks_g.dfr" PrintReport(p1,"Worksheet"&jobnr,p3,p4,p5,p6) order change index "lst_stck.idx" end for vunloadif("ftr_list.vws") return (0) END FUNCTION 'PrintJobSheet() FUNCTION FtrsWkSht() ' from L4436 ' message "Print fitters worksheet OR Returns sheet" $chstr="Worksheet Returns" while true ' screen shortrestore S_all x = colpopup(8,31,20,$chstr,"",1,0,clf,clb,0,7) 'highlight date & press {Enter} to show deliveries if x = -1 return (-1) end if if ptstr = "Worksheet" ShowFtrsWkSht() elseif ptstr="Returns" ShowReturns() end if end while vloadif(dpath|"ordstat4.vw") END FUNCTION 'FtrsWkSht() FUNCTION ShowFtrsWkSht() local y6 #thisvisit ' message "L5676 - ShowFtrsWkSht" repaint off vloadif(dpath|"delivr_2.vw") order change key "[Job_Nr]" data query execute "jobsheet.dfq" index "sd1.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Job_Nr] = jobnr ' and ' [Itemtype] <> "O" ' and ' not(deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror screen shortrestore psa messboxwait(" NO deliveries booked ",0,0,1) return (1) end if custcode=[Customer_Code] data query execute "showdel1.dfq" index "sd2.idx" ' "$ftrdate) is:"&str($ftrdate) ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Date_Out] = $ftrdate ' and ' [Fitter_Code]=$ftrcode ' and ' not(deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror screen shortrestore psa messboxwait(" NO deliveries booked for"&$ftrdate,0,0,1) return (1) end if remove(X_path|"X_ftrout.*") data query execute "not_del.dfq" Smart4 X_path|"X_ftrout" fields \ "[Job_Nr;Date_Out;Product_MRC;Description_MRC;QuantOut;Cost;Width;Fitter_Name;CustOrd_Name;Delivery_Address_1;Delivery_Address_2;Del_City;Del_Postcode;Balance_Due;Instructions;Fitting_Comment;Customer_Code;Itemtype]" vunloadif("X_ftrout.vws") remove(X_path|"Xftrout1.*") vloadif(dpath|"delivr_3.vw") order change key "[Customer_Code]" data query execute "statmnt2.dfq" Smart4 X_path|"Xftrout1" fields "[Customer_Code;Customer_Name;Contact_Name;Home_Tel;Office_Tel;Mobile/Other_Nr;Credit_Status;Title]" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Customer_Code] = custcode ' and ' not (deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror screen shortrestore psa messboxwait(" NO deliveries booked ",0,0,1) return (1) end if vunloadif("Xftrout1.vws") _SWIP_Crystal(Xreppath|"X_ftrout","S",0,1,"") END FUNCTION ' ShowDeliveries() FUNCTION ShowReturns() local y6 #thisvisit ' message "L5676 - ShowFtrsWkSht" repaint off vloadif(dpath|"delivr_2.vw") order change key "[Job_Nr]" data query execute "jobsheet.dfq" index "sd1.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Job_Nr] = jobnr ' and ' [Itemtype] <> "O" ' and ' not(deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror screen shortrestore psa messboxwait(" NO deliveries booked ",0,0,1) return (1) end if custcode=[Customer_Code] data query execute "showdel1.dfq" index "sd2.idx" ' "$ftrdate) is:"&str($ftrdate) ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Date_Out] = $ftrdate ' and ' [Fitter_Code]=$ftrcode ' and ' not(deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror screen shortrestore psa messboxwait(" NO deliveries booked for"&$ftrdate,0,0,1) return (1) end if data query execute "showdel3.dfq" index "sd3.idx" ' "$ftrdate) is:"&str($ftrdate) ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Itemtype]<>"F" ' and ' [Itemtype]<>"O" ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror screen shortrestore psa messboxwait(" NO deliveries booked for"&$ftrdate,0,0,1) return (1) end if remove(X_path|"X_ftrout.*") data query execute "not_del.dfq" Smart4 X_path|"X_ftrout" fields \ "[Job_Nr;Date_Out;Product_MRC;Description_MRC;QuantOut;Cost;Width;Fitter_Name;CustOrd_Name;Delivery_Address_1;Delivery_Address_2;Del_City;Del_Postcode;Balance_Due;Instructions;Fitting_Comment;Customer_Code;Itemtype]" vunloadif("X_ftrout.vws") remove(X_path|"Xftrout1.*") vloadif(dpath|"delivr_3.vw") order change key "[Customer_Code]" data query execute "statmnt2.dfq" Smart4 X_path|"Xftrout1" fields "[Customer_Code;Customer_Name;Contact_Name;Home_Tel;Office_Tel;Mobile/Other_Nr;Credit_Status;Title]" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Customer_Code] = custcode ' and ' not (deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror screen shortrestore psa messboxwait(" NO deliveries booked ",0,0,1) return (1) end if vunloadif("Xftrout1.vws") _SWIP_Crystal(Xreppath|"retnswks","S",0,1,"") END FUNCTION ' ShowReturns() FUNCTION CheckEstimator() local $est_yn vloadif(dpath|"shwappt3.vw") $est_yn=filelookup([shwappt3.Fitter_Code],[shwappt3.Ftr_Est],$ftrcode) ' message "name is:"&str(custname) if $est_yn="E" vloadif(dpath|"shwapte7.vw") return (0) else vloadif(dpath|"shwapte7.vw") return (-1) end if END FUNCTION 'CheckEstimator()