'BOOK_EST - enter, update and cancel Estimating Appointments '31/10/02 - copied from ALT_APPT.PF3 'conversion state ' 31/10 - none external vloadif() dpath scr sch scw vunloadif() messboxwait() ipath bge 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 external colpoplines() check_2000() public ptstr ptval ptary[1] $stock psa $ccwcode dsa $screen ftgdate public #start #end #days plist[1,1] $cust $deldate reqnnr $thisday jobnr public $daynr $ftrcode $dateftr $user $ftrdate global x $rollnr ordref $dir #speed i $1stdate $lastdate #daysleft y4 y1 y2 y3 global #recs #days2tomorrow #int $gdsout1 $gdsout2 FindFirstJobNr() y5 y6 global prodcode $backing desMRC #ordwidth prodMRC $comment ' Recall() global prodtype #nritems strtcol #asc ' ReserveRecall() CancelRecall() global CancelResvn() $popcol $itemtype $ccwidx $refnr $ftr_ch ' NavRecall() global $chckmeas #ordlen #lowerlen #upperlen #midlen $ccw ftrlist[1,2] global #rem #balance #minrsvn y strtrow $popstr z UnReserve() #delcost global startdate enddate col Reserve() BuildList() $list #oscost $loc global $date $dow $dfa $name $a1 $a2 $a3 $a4 $a5 $a6 $a7 Navigate() w global $jobstr sd ViewInfo() EnterCustName() NewGoodsOut() ' Warranty() global ftrname #appt $appth BookAppt() delpostcode recallnr LookLeft() global deladdr1 $b1 $b2 $b3 $b4 $b5 $b6 $b7 delcity ' ShowRecall() global abbrv_name title1 Show() n #prec #rec #count namelist[1,1] $idx global 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 global refcode #rem_cost $ftgnr ShowDetails() MoveRight()spc $pl global regen() wreplstr() g custname fgc bgc CheckFree() CheckBooked() global 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 global custcode rb rescol #reslin S_instr MarkAbsent() ' BookRecall() global FindJobNr() PopJobs() $slotsrem #slotsrem #apptslots ShowMin() global NameAddressAsk() DeleteAppt() S_top S_RHS S_LHS Footer() WC() global chkstr() $stat AlterApptSlots() ClearAppt() $dely $mess global NewDate() WriteApptDate() $col1 DrawLine() CheckDay() $status global CheckLabour() Conv_Resvn() Conversion() CheckNr() SetupDetails() global ReturnToMenu() ApptsMenu() cr cf ts cb Setup() global SetupScreen() ss ' ChooseAction() CancelThisItem() AllThisReqn() global #dellength #oslength ' AllUndeliveredReqns() global Screen_1() ' DeliverPart() global ReservnBooking() ReplaceHardSpace2() res ' CancelAllThisday() global colIf colIb recval #needed Delypopup() linenr ' CancelAllGoodsOut() global #listcount poplist[1] $str_list #tline #lcol #split $selected global MarkDeliveries() $permit FindAppt() ' AlterSlots_1() global ChooseFitter() ftrcode ChkDeliveries() Check4Appts() DaysLeft() global $location lr MoveAppt() $movedely nrslots ' CheckOSDeliveries() global Nav_Move() CheckNewPlace() DeliveriesOK() ShowMove() BookMove() global DeleteMoveFrom() ShowFittings() resvdat ' AlterSlots_2() global clf clb ShowDeliveries() ShowFittings2() S_all #timeout global $dfa1 $ftrappts #ftrappts ftrarray[1] $day_1 $fitter bot global 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() global EnterInstructions() WriteDetails() ChkAreas() MAIN single-step off 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 = "DCOOPR" bot = 7 clb = 13 #timeout = 60 clf = 10 WC() Setup() x = Navigate() ReturnToMenu() END MAIN FUNCTION Setup() local cl1 cl2 r1 c1 r2 c2 vloadif(dpath|"est_date.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("est_date.vws") error off colSf = 14 colSb = 12 colIf = 0 colIb = 15 repaint off vloadif(dpath|"shw_est3.vw") vloadif(dpath|"shw_est5.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 "$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|"est_appt.vws") $mess = filelookup([est_appt.DFA],[est_appt.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() $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|"shw_est5.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() y2 = format("ÿReservationÿ","M16") screen print 22 1 14 7 y2 y3 = format(" Not ready for delivery ","M27") screen print 22 17 4 7 y3 y4 = format(" Ready for delivery ","M23") screen print 22 44 10 7 y4 ' y5 = format("ÿOrder HELDÿ","M12") ' screen print 22 58 fgp bge y5 y6 = format("ÿAssisting ","M14") screen print 22 67 11 7 y6 END FUNCTION ' ShowMin() FUNCTION Reserve() '1=ALL ; 2=SOME ; 0=NONE resv'd; -1=Esc/NULL return local ba repaint off x = FindJobNr(0) 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|"shw_est5.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,"M80") screen print 1 1 fgp bgp y1 y3 = format(str(#slotsrem)&"appointments to book","M80") screen print 22 1 15 12 y3 x = messline(" Book as"&ftrname|"'s"&$appth&"appointment on"&$dow&date2(ftgdate)|"? (y/n) ",1,1,1,21,1,80) 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 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) ' 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|"shw_est5.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|"shw_est5.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 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|"shw_est5.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|"shw_est5.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|"shw_est5.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 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 #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([shw_est3.Job_Nr],[shw_est3.Customer_Code],jobnr) z1 = filelookup([shw_est3.Job_Nr],[shw_est3.CustOrd_Name],jobnr) z1 = ReplaceHardSpace(z1) z2 = filelookup([shw_est3.Job_Nr],[shw_est3.Delivery_Address_1],jobnr) z2 = ReplaceHardSpace(z2) z3 = filelookup([shw_est3.Job_Nr],[shw_est3.Del_City],jobnr) z6 = filelookup([shw_est3.Customer_Code],[shw_est3.Home_Tel],$cust) z7 = filelookup([shw_est3.Customer_Code],[shw_est3.Office_Tel],$cust) z4 = filelookup([shw_est3.Job_Nr],[shw_est3.Description],jobnr) a1 = filelookup([shw_est3.Job_Nr],[shw_est3.Appt_Slots],jobnr) a2 = filelookup([shw_est3.Job_Nr],[shw_est3.Slots_Rem],jobnr) if left(right(z4,2),1)<>";" z4 = z4|";ÿ" end if z5 = filelookup([shw_est3.Job_Nr],[shw_est3.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 ViewInfo() ' local spc2 a1 a2 ' spc2 = "ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ" ' ALT-255 spaces ' spc = "ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ" ' ALT-255 spaces ' $pl = "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÿ" ' $cust = filelookup([shw_est3.Job_Nr],[shw_est3.Customer_Code],jobnr) ' z1 = filelookup([shw_est3.Job_Nr],[shw_est3.CustOrd_Name],jobnr) ' z1 = ReplaceHardSpace(z1) ' z2 = filelookup([shw_est3.Job_Nr],[shw_est3.Delivery_Address_1],jobnr) ' z2 = ReplaceHardSpace(z2) ' z3 = filelookup([shw_est3.Job_Nr],[shw_est3.Del_Postcode],jobnr) ' z6 = filelookup([shw_est3.Customer_Code],[shw_est3.Home_Tel],$cust) ' z7 = filelookup([shw_est3.Customer_Code],[shw_est3.Office_Tel],$cust) ' z4 = filelookup([shw_est3.Job_Nr],[shw_est3.Description],jobnr) ' a1 = filelookup([shw_est3.Job_Nr],[shw_est3.Appt_Slots],jobnr) ' a2 = filelookup([shw_est3.Job_Nr],[shw_est3.Slots_Rem],jobnr) ' if left(right(z4,2),1)<>";" ' z4 = z4|";ÿ" ' end if ' z5 = filelookup([shw_est3.Job_Nr],[shw_est3.Instructions],jobnr) ' if len(z4)=0 ' z4 = "ÿÿ" ' end if ' if len(z5)=0 ' z5 = "ÿÿ" ' end if ' z8 = format(z3,"L8")|"ÿH"|format(z6,"L15")|"ÿW"|format(z7,"L15") ' z8 = ReplaceHardSpace(z8) ' z9 = left("Appt slots"&str(a1)&"(unbooked"&str(a2)|")"|spc,43) ' z9 = ReplaceHardSpace(z9) ' z = z1|z2|z8|z9|$pl|z4|chr(13)|z5 ' if BoxText(4,18,17,63,10,5,z,"L",1,0,0,$ordstat) = 0 ' wait 7 ' screen shortrestore psa ' end if ' END FUNCTION 'ViewInfo() 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 c1 r2 c2 psa SCREEN SAVE r1+1 c1+1 r2+1 c2+1 $screen 'NEW _shade() 'NEW SCREEN SHORTRESTORE $screen 'NEW ' screen clear box r1 c1 r2 c2 fg bg 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|"shw_est5.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 ' repaint off ' jobnr = ms ' vloadif(dpath|"shw_est5.vw") ' repaint on ' repaint ' ' if indirect("[A"|str(col-3)|"]") = "None" ' $dfa = [DayFitter]|str(col-3) ' x = MarkAbsent(ms,st) ' if x = 0 ' repaint on ' repaint ' end if ' else ' messbox(" Appointment already booked ",0,0,1) ' end if END FUNCTION ' Absent() FUNCTION ReInstate() repaint off vloadif(dpath|"shw_est5.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|"shw_est5.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]","L5","[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|"shw_est3.vw") $daynr = str(days(newdate)) 'message "$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 "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|"shw_est5.vw") ' data goto record record-number #prec repaint on repaint ' screen clear box 22 1 sch scw 0 0 no-border 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|"est_date.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|"est_date.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(8,33,13,"ÿÿÿJobÿNr 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 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(11,27,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|"shw_est5.vw") ftgdate = [Date] end if error on if days(ftgdate) = days(today) continue while end if cr = Conv_Resvn() if cr = 1 vloadif(dpath|"shw_est5.vw") ftgdate = [Date] $ftrcode = right([DayFitter],6) 'message "$ftrcode is:"&str($ftrcode) elseif cr = 2 vloadif(dpath|"shw_est5.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 vloadif(dpath|"shw_est5.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|"shw_est5.vw") ftgdate = [Date] $ftrcode = right([DayFitter],6) 'message "$ftrcode is:"&str($ftrcode) elseif ts = 2 vloadif(dpath|"shw_est5.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 cb = CheckBooked() if cb = -1 continue while end if ts = ClearAppt() ' message "ts) is:"&str(ts) clear jobnr return (-1) elseif ptstr = m9 ' mark as ASSIST $ch = ptstr ftgdate = [Date] if days(ftgdate) = days(today) continue while end if cf = CheckFree() if cf = -1 continue while end if #appt = col - 3 ftrname = [Nickname] $dow = [DOW] ftgdate = [Date] if indirect("[A"|str(col-3)|"]") = "None" x = ChooseFitter() ' find fitter's name if x = -1 return(-1) end if Absent(left(ftrassist,6),"A") else continue while end if elseif ptstr = m4 ' mark as ABSENT $ch = ptstr ftgdate = [Date] if days(ftgdate) = days(today) continue while end if cf = CheckFree() if cf = -1 continue while end if if base <> "O" if base <> "W" continue while 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 <> "W" 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|"shw_est5.vw") elseif ptstr = m7 ' reservations x=ReserveMenu() if x = -1 return (-1) end if elseif ptstr = m6 ' future appt x = NewDate() 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|"shw_est5.vw") ' ftgdate = [Date] ' $ftrcode = right([DayFitter],6) 'message "$ftrcode is:"&str($ftrcode) ' ' elseif ma = 2 ' ' vloadif(dpath|"shw_est5.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|"est_appt.vws") $mess = filelookup([est_appt.DFA],[est_appt.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|"est_appt.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|"shw_est5.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|"shw_est5.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|"shw_est5.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|"shw_est5.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|"shw_est5.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|"shw_est5.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|"shw_est5.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|"est_appt.vws") ' $mess = filelookup([est_appt.DFA],[est_appt.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|"est_appt.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|"shw_est5.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&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|"shw_est5.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 y2 = format(" {A}ppointments - ÿJob {D}etails - Deli{V}eries - {Esc}","M80") screen print 21 1 fgp bgp y2 y1 = format(" ","M80") screen print 22 1 fgp bgp y1 SCREEN SAVE 5 5 21 78 $screen _shade() 'NEW SCREEN SHORTRESTORE $screen 'NEW END FUNCTION 'Screen_1() ' FUNCTION DeliverMenu(dm) ' local ca ' $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 ' ca = ChooseAction(dm) ' repaint off ' WC() ' vunloadif($gdsout1) ' vunloadif($gdsout2) ' ' if dm = 0 ' ' if ca = 0 ' MarkDeliveries(ca) ' ' elseif ca = 1 ' NO deliveries ' ' ' ' end if ' 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) screen save 4 1 22 3 S_LHS screen save 4 78 22 80 S_RHS screen save 1 1 3 80 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 58 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 ' Screen_1() ' ptval=0 ' while true ' ptval = navrecs() ' if ptval = {C} or ptval = {c} ' Cancel delivery for this day ' if vo = 1 ' continue while ' end if ' x = colpopup(18,50,22,"Thisÿitemÿonly Allÿundelivered","Cancel",1,0,colSf,colSb,colIf,colIb) ' if ptstr = "Allÿundelivered" ' all for today ' CancelAllThisday() ' else ' this item only ' CancelThisItem() ' end if ' 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 ' #oscost = [Cost_OS] 'message "#oscost is:"&str(#oscost) ' prodMRC = [Product_MRC] 'message "prodMRC is:"&str(prodMRC) ' #oslength = [Quant_OS] 'message "#oslength is:"&str(#oslength) ' if [Quant_OS] = [Length_Quantity] ' return (1) ' end if ' reqnnr = [Reference_Nr] 'message "reqnnr is:"&str(reqnnr) ' data goto window 2 ' vloadif(dpath|"goodsout.vws") ' ' message "reqnnr is:"&str(reqnnr) ' ' message "$deldate is:"&str(date2($deldate)) ' 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("L3326 -"|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 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|"shw_est5.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|"est_list.vws") data query execute "not_del.dfq" index "ftrs1.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' ³ 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("est_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("est_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|"shw_est3.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|"est_list.vws") vloadif(dpath|"est_appt.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("est_appt.vws") vunloadif("delivr_1.vw") vunloadif("est_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|"est_list.vws") vloadif(dpath|"est_appt.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("est_appt.vws") vunloadif("delivr_1.vw") vunloadif("est_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() local $chstr 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 ' while true 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 $chstr = "Customer Fittings Instructions Orders Requisitions Receipts" 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 = "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() 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|"shw_est5.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}ÿ","M80") screen print 21 1 fgp bgp y1 y2 = format("ÿReservationÿ","M16") screen print 22 1 14 7 y2 y3 = format(" Not ready for delivery ","M27") screen print 22 17 4 7 y3 y4 = format(" Ready for delivery ","M23") screen print 22 44 10 7 y4 ' y5 = format("ÿOrder HELDÿ","M12") ' screen print 22 58 fgp bge y5 y6 = format("ÿAssisting ","M14") screen print 22 67 11 15 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 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 = {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] ' if $permit = "MNEGRI" ' dm = 0 ' elseif days(ftgdate) < days(today) ' dm = 1 ' else ' 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) ' else ' ' message "$ordstat is:"&str($ordstat) ' ' 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|"shw_est3.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|"shw_est5.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 h = 1 to nrslots-1 ' col = col - 1 ' suspendone ' keys Left,F8 ' end for ' end if 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|"shw_est5.vw") '?all checks made? nm=Nav_Move() 'message "nm is:"&str(nm) if nm = -1 return (-1) end if ' message "Book appts with jobnr" ' message "jobnr is:"&str(jobnr) ' message "nrslots is:"&str(nrslots) 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|"shw_est5.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|"shw_est5.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 "jobnr is:"&str(jobnr) #appt = col - 3 ftrname = [Nickname] $dow = [DOW] $ftrcode= right([DayFitter],6) 'message "$ftrcode) is:"&str($ftrcode) vloadif(dpath|"est_appt.vws") $mess = filelookup([est_appt.DFA],[est_appt.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|"est_appt.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 ' 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]" '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|"shw_est5.vw") while true $appth = case #appt (1,"1st")(2,"2nd")(3,"3rd") else str(#appt)|"th" y1 = format("Now booking appt's for"&"-"&title1,"M80") screen print 1 1 fgp bgp y1 y3 = format(str(#slotsrem)&"appointments to book","M80") screen print 22 1 15 12 y3 x = messline(" Book as"&ftrname|"'s"&$appth&"appointment on"&$dow&date2(ftgdate)|"? (y/n) ",1,1,1,21,1,80) if ptstr == "Y" ' Book appt repaint off ' repaint on ' repaint ' single-step on vloadif(dpath|"bookappt.vw") 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) Show() return (0) ' NOT booked else ' message " check that this appt is still a resv'n" ' message "$refnr is:"&str($refnr) if left([DelAddr&Code],6)<>$refnr ' message "this appt NOT connected with this resv'n" 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|"shw_est5.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 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|"shw_est5.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()