'new ORD_STAT - view order details and amend Instructions '03/02/04 - added view/amend Comments '21/02/07 - change made to search pattern "b" & 7 letters for ABBRV '28/02/07 - "Email" option removed '18/03/09 - Partial Address searches from last record backwards '14/07/09 - shows ArcReqns '18/08/14 - view Cutting Plan PDFs external messbox() vloadif() vunloadif() dpath scr shopmask fentrybox() ' popuplist() external sch scw progress() fgp bgp messline() wraptext() nr6 bgi bgs nr5 external userid menuchoice cpath entryline() navrecs() fge bge progtag() external remove() makeidx() Background() posncolpopup() colpoplines() external chkstr() strcount() colpopup() bpopdb() $menu messboxwait() _SWIP_Crystal() external #margin_A #margin_B #margin_C #margin_D fgi fgs tone() external check_2000() scbtm() _GEMS_EmailTo() invpath _GEMS_WinDialog() _GEMS_Input() external _GEMS_ShellEx() chkdate() _GEMS_ResetCtrlParam() _GEMS_Web() X_path Xreppath external _GEMS_Email() strtoary() public ptary[1] ptval $file #rec_st #rec_fin ptstr jobnr $pdf $branch public invtot custcode dsa abbrv_name $refnr psa a_jobnr $url public $ftrdate $ftrcode $screen $emailaddress maxmsg c3 mbox global x i $dfa1 $ftrappts #ftrappts $fitter $day_1 ftrname $popstr df clb clf global ShowDeliveries() ReplaceHardSpace() ftrarray[1] ShowVarns() global Show1stCash() #1stbalance #1strecord Titles_1() $showdel $invoice global CheckNr() ShowStatus() ShowAllReqs() S_details #count WriteDetails() global ReturnToMenu() jobdesc ftgcomm ftginstr ftgscrn y z slotrec y1 y2 y3 y4 global ShowInstructions() $ctgplan ftginit #lenareas #startc #startr $dateftr global $instruct EnterInstructions() #upper #rem NavReqns() S_status global $delonly ftgplan ShowText() mess5 $ordstat EnterCustName() $invdate global custname navmess() bot psmode RecsScroll() NavMess_A() orddate fmt global SetupDetails() GetCustDetails() ShowDetails() all NavMess_Arc() global custaddr1 custaddr2 custcity custpostcode deladdr1 deladdr2 #inv global deladdr3 deladdr4 cust_title custcontact offtel hometel $partaddr global offax mobile custaddr deladdr k CheckArcOrders() arc RecsScrollArc() global SearchAddress() ShowOrder() #prec CustScreenLine() UndeldReqs() global ReplaceCR() varndes ShowReceipts() l #amount $invnr ShowFittings2() global $status SearchInvoice() ReplaceHardSpace2() S_all maxdate ' EnterEmailAddress() global ShowComments() BoxText() y2a y2b y2c y2d #margin #netinv #totcost global ordvu_1 ordvu_2 ShowArcReqs() ShowArcRcpts() MaxFtgDate() OSentrybox() global ShowOrderNotes() EnterOrderNotes() messboxwaitesc() BalReqst() global popuplist() global refresh() colSf colSb uistrcnt() recs plist[1,1] mr sym global blen c2 r2 c dc lc sc pl pc rec drows udelstr() nr pg tr ' Emails() global m1 m2 m3 m4 m5 ShowInvoice() StreetMap() PrintRequest() $index global EnterEmailAddress() $email mb ViewCtgPlan() global names nextproj firstline $files nextdrive $br global $module $c $pdfstr MAIN single-step off file unload all Background() ' message "clb is:"&str(clb) ' message "clf is:"&str(clf) error off fmt = "L64" bot = 7 clb = 15 clb = 13 '- Purple clf = 10 ' clf = 1 arc = 0 $invoice = "N" ' fgp = clf ' bgp = clb while true window close if cerror exit while end if end while while true x = CheckNr() ' check Job Nr exists in CUST_ORD if x = -1 exit while end if end while ReturnToMenu() END MAIN 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 CheckNr() ' checks for JobNr - if not found while true z = 0 arc = 0 m1 = "ÿÿÿÿJobÿNr" m2 = "ÿCustomerÿName" ' m5 = "ÿÿÿPostcode" m3 = "ÿÿInvoiceÿNr" m4 = "Partialÿaddress" mbox = scw 'message "mbox is:"&str(mbox) maxmsg=max(len(m1),len(m2),len(m3),len(m4)) 'message "maxmsg is:"&str(maxmsg) c3=int((mbox-maxmsg)/2)-1 'message "c3) is:"&str(c3) x = popuplist(10,41,14,m1&m2&m3&m4,"{Esc} to exit",1,0) ' x=popuplist(9,c3,14,m1&m2&m5&m3&m4,"{Esc} to exit",1,0)' message "ptstr) is:"&str(ptstr) if x = 0 if ptstr = "Y" ' ordvu_1 = "ordstat4.vw" ordvu_2 = "ordstat2.vw" k=remove("all_req1.idx") vloadif(dpath|ordvu_1) order change key "[Job_Nr]" x = OSentrybox(" Enter Order Nr or {Esc} to exit ",6,"","",jobnr) if x = -1 return (-1) elseif x = 0 jobnr = jobnr|ptstr ' x = SetupDetails() end if elseif ptstr = "I" ' Invoice nr ordvu_1 = "ordstat4.vw" ordvu_2 = "ordstat2.vw" x = OSentrybox(" Enter Invoice Nr or {Esc} to exit ",6,nr6,"",str($invnr)) ' x = OSentrybox(" Enter Invoice Nr or {Esc} to exit ",6,nr6,$invnr) if x = -1 return (-1) elseif x = 0 $invnr=right("0000"|str($invnr)|ptstr,6) 'message "$invnr is:"&str($invnr) if len($invnr)=0 messboxwait(" Not yet invoiced ",0,0,1) continue while end if repaint off progress(15,10," Searching for `"|$invnr|"' ",0) vloadif(dpath|ordvu_1) order change key "[Inv_Nr]" data find "[Inv_Nr]" equal $invnr options "" if cerror messboxwait(" Invoice Nr"&$invnr&"not found ",0,0,1) continue while else jobnr = [Job_Nr] ' end if vloadif(dpath|ordvu_1) order change key "[Job_Nr]" x = SetupDetails() if x = -1 continue while end if end if elseif ptstr = m2 'CustomerÿName k=remove("all_req1.idx") x = EnterCustName(z) if x = -1 continue while elseif x = 2 ' using archives ordvu_1 = "a_ordst4.vw" ordvu_2 = "a_ordst2.vw" vloadif(dpath|ordvu_1) order change key "[Job_Nr]" x = SetupDetails() if x = -1 continue while end if elseif x = 0 ' using current vloadif(dpath|ordvu_1) order change key "[Job_Nr]" x = SetupDetails() if x = -1 continue while end if end if elseif ptstr = m4 '"Partialÿaddress" ordvu_1 = "ordstat4.vw" ordvu_2 = "ordstat2.vw" k=remove("all_req1.idx") vloadif(dpath|ordvu_1) order change key "[Job_Nr]" x = fentrybox(" Enter partial address details or {Esc} to exit ",35,"","") if x = -1 return (-1) elseif x = 0 $partaddr = ptstr ' repaint off progress(15,10," Searching for `"|$partaddr|"' ",0) x = SearchAddress() vloadif(dpath|ordvu_1) order change key "[Job_Nr]" x = SetupDetails() if x = -1 continue while end if end if elseif ptstr = m3 '"ÿÿInvoiceÿNr" ordvu_1 = "ordstat4.vw" ordvu_2 = "ordstat2.vw" x = fentrybox(" Enter Invoice Nr or {Esc} to exit ",6,nr6,"") if x = -1 return (-1) elseif x = 0 $invnr = right("0000"|ptstr,6) ' repaint off progress(15,10," Searching for `"|$invnr|"' ",0) vloadif(dpath|ordvu_1) order change key "[Inv_Nr]" data find "[Inv_Nr]" equal $invnr options "" if cerror messboxwait(" Invoice Nr"&$invnr&"not found ",0,0,1) continue while else jobnr = [Job_Nr] ' end if vloadif(dpath|ordvu_1) order change key "[Job_Nr]" x = SetupDetails() if x = -1 continue while end if end if elseif ptstr = m1 '"ÿÿ Job Nr" ordvu_1 = "ordstat4.vw" ordvu_2 = "ordstat2.vw" k=remove("all_req1.idx") vloadif(dpath|ordvu_1) 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 x=SetupDetails() end if end if elseif x = -1 return (-1) end if end while END FUNCTION ' CheckNr() FUNCTION GetCustDetails() $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 cr1 = 10 ' cc1 = 2 ' cc1 = 22 cc1 = 17 cr2 = cr1+5 cc2 = cc1+37 dr1 = cr1 ' dc1 = 42 dc1 = cc1+40 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 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 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 screen clear box 10 1 sch scw 0 0 no-border END FUNCTION ' ShowCustomer() FUNCTION ShowVarns() 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 messboxwait(" No orders entered for this Job - report to Head Office ",0,0,1) return (-1) else ordvu_1 = "ordstat4.vw" ordvu_2 = "ordstat2.vw" ' 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 ' data goto record next end for vunloadif("variat_n.vws") while true x = colpoplines(10,17,23,$ordstr,"",1,0,clf,clb,14,3) 'highlight date & press {Enter} to show deliveries if x = -1 exit while end if end while inchar screen shortrestore psa END FUNCTION ' ShowVarns() 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 ' data goto record next end for vunloadif("os_rcpts.vw") x = colpoplines(10,17,24,$rcpstr,"",1,0,clf,clb,14,3) 'highlight date & press {Enter} to show deliveries screen shortrestore dsa inchar ' repaint on ' repaint ' single-step on END FUNCTION ' ShowReceipts() 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 ShowText() x=wraptext(9,14,13,86,15,1,jobdesc,"L",1,0,0) ' mess5 = "Job details"|@if(slotrec=0,""," - (timeslots"&str(slotrec)|")") screen print 9 16 15 1 mess5 x = wraptext(14,14,17,86,15,1,ftginstr,"L",1,0,0) screen print 14 16 15 1 "Other comments (eg appointment times etc)" x = wraptext(18,14,21,86,15,1,ftgcomm,"L",1,0,0) screen print 18 16 15 1 "Comments re Fitting" END FUNCTION ' ShowText() FUNCTION ReturnToMenu() file unload all screen clear box 1 1 sch scw 0 0 no-border repaint off transfer cpath|"pm_menu.psl" in-memory END FUNCTION ' ReturnToMenu() FUNCTION ShowStatus() local mess1 r1 r2 c1 c2 cl1 cl2 i r1 = 5 r2 = r1+3 c1 = 60 c2 = c1+20 if $invoice = "Y" cl1 = 15 cl2 = 10 screen clear box r1 c1 r2 c2 cl1 cl2 screen print r1+1 c1+5 cl1 cl2 "ÿÿINVOICED" screen print r1+2 c1+2 cl1 cl2 $invnr|" - "|date2($invdate) else mess1 = case $ordstat ("A","Initial only")("U","All details held")\ ("R","To be authorised")("H","Held for check")("V","Rejected")("P","Authorised")\ ("L","Being prepared")("D","Despatched") else "Missing" if $ordstat = "A" cl1 = 14 cl2 = 0 screen clear box r1 c1 r2 c2 cl1 cl2 screen print r1+1 c1+5 cl1 cl2 "ORDER STATUS" screen print r1+2 c1+5 cl1 cl2 mess1 elseif $ordstat = "U" cl1 = 14 cl2 = 0 screen clear box r1 c1 r2 c2 cl1 cl2 screen print r1+1 c1+5 cl1 cl2 "ORDER STATUS" screen print r1+2 c1+3 cl1 cl2 mess1 elseif $ordstat = "R" cl1 = 10 cl2 = 0 screen clear box r1 c1 r2 c2 cl1 cl2 screen print r1+1 c1+5 cl1 cl2 "ORDER STATUS" screen print r1+2 c1+3 cl1 cl2 mess1 elseif $ordstat = "V" for i = 1 to 15 cl1 = 4 cl2 = 0 screen clear box r1 c1 r2 c2 cl1 cl2 screen print r1+1 c1+5 cl1 cl2 "ORDER STATUS" screen print r1+2 c1+7 cl1 cl2 mess1 wait .1 cl1 = 0 cl2 = 4 screen clear box r1 c1 r2 c2 cl1 cl2 screen print r1+1 c1+5 cl1 cl2 "ORDER STATUS" screen print r1+2 c1+7 cl1 cl2 mess1 wait .1 end for elseif $ordstat = "H" for i = 1 to 15 cl1 = 4 cl2 = 0 screen clear box r1 c1 r2 c2 cl1 cl2 screen print r1+1 c1+5 cl1 cl2 "ORDER STATUS" screen print r1+2 c1+4 cl1 cl2 mess1 wait .1 cl1 = 0 cl2 = 4 screen clear box r1 c1 r2 c2 cl1 cl2 screen print r1+1 c1+5 cl1 cl2 "ORDER STATUS" screen print r1+2 c1+4 cl1 cl2 mess1 wait .1 end for elseif $ordstat = "P" cl1 = 10 cl2 = 0 screen clear box r1 c1 r2 c2 cl1 cl2 screen print r1+1 c1+5 cl1 cl2 "ORDER STATUS" screen print r1+2 c1+6 cl1 cl2 mess1 elseif $ordstat = "L" cl1 = 4 cl2 = 0 screen clear box r1 c1 r2 c2 cl1 cl2 screen print r1+1 c1+5 cl1 cl2 "ORDER STATUS" screen print r1+2 c1+4 cl1 cl2 mess1 elseif $ordstat = "D" cl1 = 10 cl2 = 0 screen clear box r1 c1 r2 c2 cl1 cl2 screen print r1+1 c1+5 cl1 cl2 "ORDER STATUS" screen print r1+2 c1+6 cl1 cl2 mess1 end if end if screen save r1 c1 r2 c2 S_status END FUNCTION ' ShowStatus() 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 RecsScroll() local x bot psmode screen save scrheight 1 scrheight scrwidth bot smartpeek $_spndmes psmode if psmode = 1 smartpoke $_spndmes 0 end if while TRUE NavMess_A() x = inchar if x = {Down} data goto record next NavMess_A() elseif x = {Up} data goto record previous NavMess_A() elseif x = {PgDn} data goto page next NavMess_A() elseif x = {PgUp} data goto page previous NavMess_A() elseif x = {^End} data goto record last NavMess_A() elseif x = {^Home} data goto record first NavMess_A() elseif x = {Home} suspendone keys Home,F8 screen shortrestore bot NavMess_A() elseif x = {End} suspendone keys End,F8 screen shortrestore bot NavMess_A() else exit while end if end while if psmode = 1 smartpoke $_spndmes 1 end if return (x) END FUNCTION ' RecsScroll() FUNCTION NavMess_A() local ftgdate ordstat mess1 col1 mess2 col1 = 12 ftgdate = [Fitting_Date] ' "ftgdate) is:"&date2(ftgdate) ordstat = [Order_Status] ' "ordstat) is:"&str(ordstat) jobnr = [Job_Nr] ' "jobnr) is:"&str(jobnr) mess1 = format("Job Nr"&[Job_Nr]&"- Ftg Date:"&format(@if([Fitting_Date]=blank,"NONE!",date2([Fitting_Date])),"L10")&"- Status:"&[$case],"M71") if [Invoice_Total] < 0 mess2 = format("Credit note for:"¤cy(abs([Invoice_Total]))&"- balance o/s:"¤cy([Balance_Due]),"M71") else mess2 = format("Inv Nr"&[Inv_Nr]&"Order value:"¤cy([Invoice_Total])&"- balance o/s:"&format(currency([Balance_Due]),"R9"),"M71") ' mess2 = format("Order value:"¤cy([Invoice_Total])&"- balance o/s:"&format(currency([Balance_Due]),"R9"),"M71") end if screen print 19 6 15 col1 mess1 if arc = 0 screen print 20 6 15 col1 mess2 end if END FUNCTION 'NavMess_A() FUNCTION ShowDetails() local c1 c2 c3 c4 d1 d2 d3 d4 cc1 cr1 cc2 cr2 dc1 dr1 dc2 dr2 pc1 pr1 pc2 pr2 \ ordets p1 p2 p3 p4 p5 p6 p7 p8 df ' ordets p1 p2 p3 p4 p5 p6 p7 p8 clf clb df ' 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 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's addressÿ" 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 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 repaint off END FUNCTION ' ShowDetails() FUNCTION CheckArcOrders(a) while true Background() vloadif(dpath|"a_ordst2.vw") if a = 1 order change key "[Abbrv_Name]" data find "[Abbrv_Name]" equal abbrv_name options "" if cerror messboxwait(" Name"&chr(34)|abbrv_name|chr(34)|" not held on file ",0,0,1) return (-1) end if elseif a = 0 order change key "[Job_Nr]" data find "[Job_Nr]" equal jobnr options "gw" if cerror messboxwait(" Job Nr ("|jobnr|") not held on file ",0,0,1) return (-1) end if end if repaint on repaint ptval=0 y4 = format(" ****************************************************","M71") y3 = format(" ***************** ARCHIVED ORDERS ***************","M71") y1 = format(" Name Delivery Address","L71") y2 = format(" {Enter} selects - {Esc} exits ","M71") screen print 1 6 fgp 13 y4 screen print 2 6 fgp 13 y3 screen print 3 6 fgp 13 y4 screen print 4 6 fgp bgp y1 screen print 18 6 fgp bgp y2 screen print 20 6 fgp 13 y4 screen print 21 6 fgp 13 y3 screen print 22 6 fgp 13 y4 while true ptval = RecsScrollArc() if ptval = {Enter} repaint off jobnr = [Job_Nr] arc = 1 return (0) elseif ptval = {Esc} screen clear box 1 1 sch scw 0 0 no-border repaint off return (-1) end if end while end while END FUNCTION ' CheckArcOrders() FUNCTION EnterCustName(z) while true if z = 0 while true x = fentrybox(" Enter first 7 letters of Name (inc. capitals) - {Esc} ",7,"","") if x = 0 if len(ptstr)=0 continue while end if exit while elseif x = -1 return (-1) end if end while abbrv_name = ptstr Background() ordvu_1 = "ordstat4.vw" ordvu_2 = "ordstat2.vw" vloadif(dpath|ordvu_2) order change key "[Abbrv_Name]" data goto record last data find "[Abbrv_Name]" equal abbrv_name options "b" if cerror messbox(" Name"&chr(34)|abbrv_name|chr(34)|" not on file - search archives? (y/n) ",1,1,1) if ptstr == "y" arc = 1 x = CheckArcOrders(1) if x = -1 return (-1) else Background() ordvu_1 = "a_ordst4.vw" ordvu_2 = "a_ordst2.vw" jobnr = [Job_Nr] return (2) ' using archived files end if else continue while end if else end if else ordvu_1 = "ordstat4.vw" ordvu_2 = "ordstat2.vw" vloadif(dpath|ordvu_2) end if CustScreenLine() while true ptval = RecsScroll() if ptval = {Enter} repaint off jobnr = [Job_Nr] vloadif(dpath|ordvu_1) order change key "[Job_Nr]" x = SetupDetails() vloadif(dpath|ordvu_2) CustScreenLine() continue while elseif ptval = {a} x = CheckArcOrders(1) if x = -1 exit while else screen clear box 1 1 sch scw 0 0 no-border repaint off jobnr = [Job_Nr] return (2) ' using archived files end if elseif ptval = {Esc} ' "Escaping from EnterCustNAme - L705" screen clear box 1 1 sch scw 0 0 no-border repaint off return (-1) end if end while end while END FUNCTION 'EnterCustName() FUNCTION RecsScrollArc() local x bot psmode screen save scrheight 1 scrheight scrwidth bot smartpeek $_spndmes psmode if psmode = 1 smartpoke $_spndmes 0 end if while TRUE NavMess_Arc() x = inchar if x = {Down} data goto record next NavMess_Arc() elseif x = {Up} data goto record previous NavMess_Arc() elseif x = {PgDn} data goto page next NavMess_Arc() elseif x = {PgUp} data goto page previous NavMess_Arc() elseif x = {^End} data goto record last NavMess_Arc() elseif x = {^Home} data goto record first NavMess_Arc() elseif x = {Home} suspendone keys Home,F8 screen shortrestore bot NavMess_Arc() elseif x = {End} suspendone keys End,F8 screen shortrestore bot NavMess_Arc() else exit while end if end while if psmode = 1 smartpoke $_spndmes 1 end if return (x) END FUNCTION ' RecsScrollArc() FUNCTION NavMess_Arc() local ftgdate ordstat mess1 col1 mess2 col1 = 12 orddate = [Date_Of_Order] ftgdate = [Fitting_Date] ' "ftgdate) is:"&date2(ftgdate) ordstat = [Order_Status] ' "ordstat) is:"&str(ordstat) jobnr = [Job_Nr] ' "jobnr) is:"&str(jobnr) mess1 = format("Job Nr"&[Job_Nr]&"- Ftg Date:"&format(@if([Fitting_Date]=blank,"NONE!",date2([Fitting_Date])),"L8")&"- Status:"&[$case],"M71") if [Invoice_Total] < 0 mess2 = format("Order date:"&date2(orddate)&"Credit note for:"¤cy(abs([Invoice_Total])),"M71") else mess2 = format("Order date:"&date2(orddate)&"-"&"Order value:"&format(currency([Invoice_Total]),"R8"),"M71") end if screen print 19 6 15 col1 mess1 if arc = 0 screen print 20 6 15 col1 mess2 end if END FUNCTION 'NavMess_A() FUNCTION Show1stCash() local $puar ptval=0 repaint off 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) return (-1) end if repaint on repaint screen shortrestore S_details Titles_1() inchar return (-1) END FUNCTION ' Show1stCash() FUNCTION SearchAddress() vloadif(dpath|"ordstat5.vw") data goto record last while true progress(15,10," Searching for `"|$partaddr|"' in Delivery Address Line 1 ",0) data find "[Delivery_Address_1]" partial $partaddr options "bi" progtag(fgi,bgi," Searching record"&str(precord)&"of"&str(precords)|" ") if cerror data goto record last while true progress(15,10," Searching for `"|$partaddr|"' in Delivery Address Line 2 ",0) data find "[Delivery_Address_2]" partial $partaddr options "bi" progtag(fgi,bgi," Searching record"&str(precord)&"of"&str(precords)|" ") if cerror messboxwait(" `"|$partaddr|"' not found in Customer Order file ",0,0,1) Background() return (1) else #prec = precord x = ShowOrder() if x = 0 return (0) ' correct found & SEEN! elseif x = -1 return (-1) ' end if end if end while else #prec = precord x = ShowOrder() if x = 0 return (0) ' correct found & SEEN! elseif x = -1 return (-1) ' end if end if end while END FUNCTION ' SearchAddress() ' FUNCTION SearchAddress() ' vloadif(dpath|"ordstat5.vw") ' data goto record last ' while true ' data find "[Delivery_Address_1]" partial $partaddr options "bi" ' if cerror ' data goto record last ' while true ' data find "[Delivery_Address_2]" partial $partaddr options "bi" ' if cerror ' messboxwait(" `"|$partaddr|"' not found in Customer Order's file ",0,0,1) ' Background() ' return (1) ' else ' #prec = precord ' x = ShowOrder() ' if x = 0 ' return (0) ' correct found & SEEN! ' elseif x = -1 ' return (-1) ' ' end if ' end if ' end while ' ' else ' #prec = precord ' x = ShowOrder() ' if x = 0 ' return (0) ' correct found & SEEN! ' elseif x = -1 ' return (-1) ' ' end if ' end if ' end while ' END FUNCTION ' SearchAddress() FUNCTION ShowOrder() vloadif(dpath|ordvu_1) data goto record record-number #prec repaint on repaint x = messbox(" Is this the order? (y/n) ",1,1,0) if x = -1 return (-1) else if ptstr == "y" jobnr = [Job_Nr] return (0) ' correct found & SEEN! else repaint off progress(15,10," Searching for `"|$partaddr|"' ",0) vloadif(dpath|"ordstat5.vw") data goto record previous return (1) end if end if END FUNCTION ' ShowOrder() FUNCTION CustScreenLine() repaint on repaint ptval=0 y1 = format(" Name Delivery Address","L71") y2 = format(" {A}rchived orders - {Enter} selects - {Esc} exits ","M71") screen print 4 6 fgp bgp y1 screen print 21 6 fgp bgp y2 END FUNCTION ' CustScreenLine() FUNCTION ReplaceHardSpace(str1) local j r m bw l_last #addn m = "" for j = 1 to len(str1) r = mid(str1,j,1) if r = " " r = "ÿ" ' replace hard space end if m = m|r end for m = m|repeat("ÿ",#addn) return (m) END FUNCTION ' ReplaceHardSpace() FUNCTION 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 ShowComments() ' x=wraptext(9,14,13,66,clf,clb,jobdesc,"L",1,0,0) ' "x is:"&str(x) x=wraptext(8,14,12,86,clf,clb,jobdesc,"L",1,0,0) ' "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,86,clf,clb,ftginstr,"L",1,0,0) screen print 13 16 clf clb "Other comments (eg appointment times etc)" x = wraptext(17,14,20,86,clf,clb,ftgcomm,"L",1,0,0) screen print 17 16 clf clb "Comments re Fitting" ShowInstructions() screen clear box 7 1 sch scw 0 0 no-border END FUNCTION ' ShowComments() 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,73) ' 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","M73") screen print 21 14 15 1 y x=wraptext(8,14,12,86,7,1,jobdesc,"L",1,0,0) ' "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,86,7,1,ftgcomm,"L",1,0,0) screen print 17 16 7 1 "Comments re Fitting" while true #lenareas = len(ftginstr) ' "#lenareas) is:"&str(#lenareas) #startc = mod(#lenareas,50) #startr = int(#lenareas/50)+1 screen editor 13 14 16 86 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,86,7,1,ftginstr,"L",1,0,0) screen print 13 16 7 1 "Other comments (eg appointment times etc)" while true #lenareas = len(ftgcomm) ' "#lenareas) is:"&str(#lenareas) #startc = mod(#lenareas,50) #startr = int(#lenareas/50)+1 screen editor 17 14 20 86 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,73) if ptstr == "y" if len(ftginstr) = 0 messbox(" Must enter instructions ",0,0,1) continue while else vloadif(dpath|ordvu_1) order change key "[Job_Nr]" data find "[Job_Nr]" equal jobnr options "" WriteDetails() vunloadif(ordvu_1) return (0) end if else continue while end if end while END FUNCTION ' EnterInstructions() FUNCTION SearchInvoice() vloadif(dpath|ordvu_1) order change key "[Inv_Nr]" while true data find "[Inv_Nr]" equal $invnr options "" if cerror messboxwait("L1193\ Invoice Nr"&$invnr&"not found ",0,0,1) return (1) else jobnr = [Job_Nr] return (0) ' correct found & SEEN! end if end while END FUNCTION ' SearchInvoice() FUNCTION NavReqns() local x psmode pd pq #percentmargin y4 = format("ÿReq'ns in purple have not been fully scheduled for delivery ","M78") screen print 8 2 13 1 y4 ' if $menu == "boss" ' #totcost = filesum([Cost]) ' #margin = (#netinv-#totcost)/#netinv ' #percentmargin = round(#margin*100,2) ' "#percentmargin is:"&str(#percentmargin) ' y3 = format("ÿ"|chr(24)&chr(25)&"req'ns ("|str(#count)|") {P}urchase details {Esc} to exit (Margin"&fixed(#percentmargin,1)|"%"|")","M78") ' if #margin < #margin_A ' screen print 9 2 12 1 y3 ' elseif #margin < #margin_B ' screen print 9 2 14 1 y3 ' elseif #margin < #margin_C ' screen print 9 2 10 1 y3 ' elseif #margin < #margin_D ' screen print 9 2 14 1 y3 ' else ' screen print 9 2 12 1 y3 ' end if ' else y3 = format("ÿ"|chr(24)&chr(25)&"req'ns ("|str(#count)|") {P}urchase details {Esc} to exit ","M78") screen print 9 2 15 1 y3 ' end if screen save scrheight 1 scrheight scrwidth bot smartpeek $_spndmes psmode if psmode = 1 smartpoke $_spndmes 0 end if while TRUE x = inchar if x = {Down} data goto record next elseif x = {Up} data goto record previous elseif x = {PgDn} data goto page next elseif x = {PgUp} data goto page previous elseif x = {^End} data goto record last elseif x = {^Home} data goto record first elseif x = {P} or x = {p} NavMess() else exit while end if end while if psmode = 1 smartpoke $_spndmes 1 end if return (x) END FUNCTION 'NavReqns() FUNCTION BoxText(r1,c1,r2,c2,fg,bg,jst,sprn,sml,pg) local dr a b $line fmt b = dr clear psa screen save r1 c1 r2 c2 psa screen clear box r1 c1 r2 c2 fg bg screen print (r1+1) c1+2 fg bg format fmt y2 screen print (r1+2) c1+2 fg bg format fmt y2a screen print (r1+3) c1+2 fg bg format fmt y2c screen print (r1+4) c1+2 fg bg format fmt y2b screen print (r1+5) c1+2 fg bg format fmt y2d screen save r1 c1 r2 c2 dsa redimension ptary[1] ptval = a return (0) END FUNCTION 'BoxText(r1,c1,r2,c2,fg,bg,ts,jst,sprn,sml,pg) FUNCTION NavMess() local col1 pd pq pr psc psn psr psp pq1 pinv piv pss dld if [Item_Type] = "B" or [Item_Type]="W" or [Item_Type]="J" or [Item_Type]="T" or [Item_Type]="O" pr = [Date_Allocated] ' "pr is:"&date2(pr) $refnr = [Reference_Nr] ' "$refnr is:"&str($refnr) error off pd = filelookup([purchord.Order_Nr],[purchord.Date_Ordered],$refnr) ' "pd is:"&str(pd) if cerror messboxwait(" Reference NOT found in PURCHORD.DB ",0,0,1) return (1) else pq = filelookup([purchord.Order_Nr],[purchord.Delivery_Quoted],$refnr) pq1 = @if(pq=null,"N/Q",pq) ' "pq1 is:"&str(pq1) psc = filelookup([purchord.Order_Nr],[purchord.Supplier_Code],$refnr) psr = filelookup([purchord.Order_Nr],[purchord.Order_Reference],$refnr) pss = filelookup([purchord.Order_Nr],[purchord.Del],$refnr) psn = filelookup([supplier.Supplier_Code],[supplier.Name],psc) psp = filelookup([supplier.Supplier_Code],[supplier.Telephone],psc) dld = case pss ("W","Warehouse")("F","Fulham")("R","Raynes")("P","Putney")("S","Sheen")("O","Collected")("I","On Site") if value(pr)=0 ' NOT received y2 = format("Ordered on"&date2(pd)&"- for delivery:"&pq1,fmt) y2a = format(left("From:"&psn&"-"&psp,66),fmt) y2c = format(left("Ref:"|psr,66),fmt) ' "len(y2a) is:"&str(len(y2a)) y2b = format("",fmt) ' "y2 is:"&str(y2) y2d = format(left("Deliver to:"&dld,66),fmt) ' "y2d is:"&str(len(y2a)) else y2a = format(left("From:"&psn&"-"&psp,66),fmt) y2c = format(left("Ref:"|psr,66),fmt) ' "len(y2a) is:"&str(len(y2a)) y2d = format(left("Delivered to:"&dld,66),fmt) ' "y2d is:"&str(len(y2a)) pinv= filelookup([gds_rcvd.Order_Nr],[gds_rcvd.Invoice_Nr],$refnr) if $menu == "offc" or $menu == "boss" piv = filelookup([gds_rcvd.Order_Nr],[gds_rcvd.Invoice_Cost],$refnr) y2b = format(left(@if(pinv=blank,"","Invoice amount"¤cy(piv)),65),fmt) else y2b = format("",fmt) ' "y2 is:"&str(y2) end if y2 = format(left(@if(pinv=blank,"Order received on"&date2(pr)&"(Invoice not rec'd)","Order received on"&date2(pr)|"ÿ(Inv Nr"&pinv|")"),65),fmt) end if col1 = 1 end if if BoxText(1,7,7,73,10,5,"L",1,0,0) = 0 wait 7 screen shortrestore psa end if else return (1) end if END FUNCTION 'NavMess() FUNCTION UndeldReqs() local y6 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 undelivered requisitions ",0,0,1) ' fgp = fgpleasing ' bgp = bgpleasing return (1) end if data query execute "undelivd.dfq" index "ud2.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Quant_OS]>.01 ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror screen shortrestore psa messboxwait(" NO undelivered requisitions ",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") screen print 6+records 26 fgp bgp y6 x = bpopdb("delivr_1",6,"","[ScrollView]","L53","[Quant_OS]","R6","[Job_Nr]",4,26,20,80,"",0) screen clear box 6+records 26 6+records 80 0 0 no-border ' fgp = fgpleasing ' bgp = bgpleasing END FUNCTION ' UndeldReqs() FUNCTION MaxFtgDate() repaint off vloadif(dpath|"appntmnt.vws") order change physical data query execute "job_reqn.dfq" index "job_reqn.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' ³ QUERY is: [Job_Nr] = jobnr and not (deleted) ³ ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror return (1) end if maxdate=filemax([Date]) vunloadif("appntmnt.vws") END FUNCTION ' MaxFtgDate() FUNCTION SetupDetails() local $chstr data find "[Job_Nr]" equal jobnr options "gw" if cerror messbox(" Job Nr ("&jobnr|") not found - search archives? (y/n) ",1,1,1) if ptstr == "y" arc = 1 x = CheckArcOrders(0) if x = -1 return (-1) else Background() ordvu_1 = "a_ordst4.vw" ordvu_2 = "a_ordst2.vw" vloadif(dpath|ordvu_1) data find "[Job_Nr]" equal jobnr options "gw" if cerror messboxwait(" Job Nr ("&jobnr|") not found in archives ",0,0,1) return (-1) end if end if else return (-1) end if else MaxFtgDate() vloadif(dpath|ordvu_1) if days(maxdate)=0 lock-record [Fitting_Date]=blank write-record else lock-record [Fitting_Date]=maxdate write-record end if 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] #netinv = [Net_Invoice] if arc<>1 $emailaddress=[Email_Addr] end if deladdr4=[Del_Postcode] custcode=[Customer_Code] end if repaint on repaint screen save 1 1 7 scw S_all repaint off vunloadif(ordvu_1) ' $chstr = "Customer Fittings Instructions Orders Requisitions Receipts Email BalanceÿRequest Invoice StreetMap Comments" if arc = 1 $chstr = "Customer Requisitions Receipts Invoice StreetMap" else ' $chstr = "Customer Fittings Instructions Orders Requisitions Receipts Email BalanceÿRequest Invoice StreetMap Comments" $chstr="Customer Fittings Instructions Orders Requisitions Receipts Email BalanceÿRequest Invoice CuttingÿPlan StreetMap Comments" end if while true screen shortrestore S_all scbtm() ' screen clear box 24 1 25 80 0 0 no-border ' mbox = scw 'message "mbox is:"&str(mbox) ' maxmsg=max(len(m1),len(m2),len(m3),len(m4)) 'message "maxmsg is:"&str(maxmsg) ' c3=int((mbox-maxmsg)/2)-1 'message "c3) is:"&str(c3) ' x = popuplist(9,30,13,m1&m2&m3&m4,"{Esc} to exit",1,0) ' x = colpopup(10,41,22,$chstr,"{Esc} to exit",1,0,clf,clb,0,7) 'highlight date & press {Enter} to show deliveries x = popuplist(10,41,22,$chstr,"{Esc} to exit",1,0) 'highlight date & press {Enter} to show deliveries if x = -1 Background() return (-1) end if if ptstr = "Instructions" if arc = 1 messboxwait(" Not available for archived orders ",0,0,1) continue while end if ShowComments() ' {I}nstructions screen shortrestore S_all elseif ptstr = "StreetMap" x = StreetMap() screen shortrestore S_all elseif ptstr = "BalanceÿRequest" if arc = 1 messboxwait(" Not available for archived orders ",0,0,1) continue while end if progress(15,10," Printing Balance Request Letter ",0) x=BalReqst() screen shortrestore S_all elseif ptstr = "Receipts" #1stbalance = 0 if arc = 1 x = ShowArcRcpts() else x = ShowReceipts() end if screen clear box 10 1 sch scw 0 0 no-border ' screen shortrestore S_all elseif ptstr = "Customer" repaint off vloadif(dpath|ordvu_1) order change key "[Job_Nr]" data find "[Job_Nr]" equal jobnr options "" GetCustDetails() vunloadif(ordvu_1) ShowCustomer() screen shortrestore S_all elseif ptstr = "Fittings" if arc = 1 messboxwait(" Not available for archived orders ",0,0,1) continue while end if x = ShowFittings2() screen shortrestore S_all elseif ptstr = "Orders" if arc = 1 messboxwait(" Not available for archived orders ",0,0,1) continue while end if x = ShowVarns() screen shortrestore S_all elseif ptstr = "Invoice" if arc = 1 messboxwait(" Contact Head Office to check if copy available ",0,0,1) continue while end if x = ShowInvoice() screen shortrestore S_all elseif ptstr = "Email" EnterEmailAddress() ' if arc = 1 ' messboxwait(" Not available for archived orders ",0,0,1) ' continue while ' end if ' messboxwait(" Not yet available ",0,0,1) continue while ' x = Emails() ' _GEMS_ResetCtrlParam() ' screen shortrestore S_all elseif ptstr = "Comments" if arc = 1 messboxwait(" Not available for archived orders ",0,0,1) continue while end if x = ShowOrderNotes() screen shortrestore S_all elseif ptstr = "CuttingÿPlan" 'message "Ctg plan" x=ViewCtgPlan() screen shortrestore S_all elseif ptstr = "Requisitions" ' message "arc is:"&str(arc) if arc = 1 ShowArcReqs() end if x = ShowAllReqs() ' message "x is:"&str(x) if x=1 messboxwait(" Showing Req'ns from Archive file ",0,0,1) ShowArcReqs() end if screen shortrestore S_all end if end while END FUNCTION ' SetupDetails() FUNCTION ShowArcRcpts() local rcptdes $rcpstr $rcpstr = "" repaint off ptval=0 vloadif(dpath|"a_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 ' "$popstr is:"&str($popstr) data goto record next end for vunloadif("a_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 ' ShowArcRcpts() 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 '------------------------------------- 'sl = string group 'i = counter for group() function 's = string counter increment 'lo = low search record 'hi = high search record 'c = temporary equation to find NULL '------------------------------------- 'returns count of strings in string ' group '------------------------------------- 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 '------------------------------------- 's = string to check 'sl = string group 't = targeted string to check 'i = counter for group() function 'n = new string group 'f = list changed flag '------------------------------------- 'returns: success = list less item ' failure = original list '------------------------------------- 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 popuplist(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 if recs > scrheight if mnu = 1 screen clear box hml 1 hml scrwidth 0 0 no-border screen print hml 1 bgi bgs "Building list..." end if end if ptstr=NULL if mnu = 1 hm = case num (0,"Enter = select/unselect F10 = done Esc = exit") \ (1,"Enter = select Esc = exit (select: 1 item)") \ else "Enter = select/unselect F10 = done Esc = exit " & \ " (select up to:" & str(num) & "items)" else hm = NULL end if sym = spsymmap(28) cnum=0 blen=0 l=blen for c=1 to recs plist[c,2]=group(list,c) l=len(plist[c,2]) plist[c,1]=0 if l>blen blen=l end if end for c2=c1+blen+2 r2=r1+recs if r2>mr r2=mr end if dc=(c2-c1) lc=c1+1 pad = case num (1,1) else 2 sc=c1+pad-1 pl=(r2-r1) padc = repeat(chr(32),pad) for i = 1 to recs pc = 1 plist[i,2]=padc|format(plist[i,2],"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+3 c2+pad+1 psa 'NEW screen save r1 c1 r2+2 c2+pad psa 'ORIGINAL ' ############## New for SHADE ############################## ' SCREEN SAVE r1+1 c1+1 r2+2 c2+pad+1 $screen 'NEW ' _shade() 'NEW ' SCREEN SHORTRESTORE $screen 'NEW ' ############## END of New for SHADE ####################### 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 ' "k is:"&str(k) 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=48 ptstr="I" $invnr="0" ptval = nr return (0) elseif k=49 ptstr="I" $invnr="1" ptval = nr return (0) elseif k=50 ptstr="I" $invnr="2" ptval = nr return (0) elseif k=51 ptstr="I" $invnr="3" ptval = nr return (0) elseif k=52 ptstr="I" $invnr="4" ptval = nr return (0) elseif k=53 ptstr="I" $invnr="5" ptval = nr return (0) elseif k=54 ptstr="I" $invnr="6" ptval = nr return (0) elseif k=55 ptstr="I" $invnr="7" ptval = nr return (0) elseif k=56 ptstr="I" $invnr="8" ptval = nr return (0) elseif k=57 ptstr="I" $invnr="9" ptval = nr return (0) elseif k=102 or k=70 ptstr="Y" jobnr="F" ptval = nr return (0) elseif k=114 or k=82 ptstr="Y" jobnr="R" ptval = nr return (0) elseif k=112 or k=80 ptstr="Y" jobnr="P" ptval = nr return (0) elseif k=115 or k=83 ptstr="Y" jobnr="S" ptval = nr return (0) elseif k=116 or k=84 ptstr="Y" jobnr="T" ptval = nr return (0) elseif k=119 or k=87 ptstr="Y" jobnr="W" ptval = nr return (0) 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 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 'popuplist() FUNCTION OSentrybox(msg,elen,msk,dfalt,$init) local tgt lmsg mbox r1 r2 c1 c2 c3 c4 errscn ptstr = NULL tgt = BLANK lmsg=len(msg) mbox = scrwidth if (lmsg+4) > scrwidth return (-2) end if r1 = scr-4 r2 = scr+2 if lmsg >= elen c3 = int((mbox-lmsg)/2)+1 ' c4 = int((mbox-elen)/2)+1 c4 = int((mbox-elen)/2)+2 c2 = c3 + lmsg + 1 c1 = c3-2 else c3 = int((mbox-lmsg)/2)+1 c4 = int((mbox-elen)/2)+1 if c4 < 3 c4 = 3 end if c2 = c4 + elen + 1 if c2 > scrwidth c2 = scrwidth end if c1 = c4-2 end if 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 screen save r1 c1 r2 c2 psa 'ORIGINAL screen clear box r1 c1 r2 c2 fgp bgp screen print r1+2 c3 fgp bgp msg if exact(msk,NULL)=FALSE screen print scr c4 fgi bgi $init screen input scr c4+1 fgi bgi elen tgt MASK msk dfalt else if dfalt = NULL screen print scr c4 fgi bgi $init screen input scr c4+1 fgi bgi elen tgt else screen print scr c4 fgi bgi $init screen input scr c4+1 fgi bgi elen tgt dfalt end if end if screen save r1 c1 r2 c2 dsa screen shortrestore psa if tgt = BLANK ptstr = NULL return (-1) else ptstr = str(tgt) return (0) end if END FUNCTION 'OSentrybox() FUNCTION ShowOrderNotes() local mess2 $ordstr #line $ordstr = "" repaint off vloadif(dpath|"comments.vws") order change physical data query execute "job_reqn.dfq" index "job_reqn.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' ³ QUERY is: [Job_Nr] = jobnr and not (deleted) ³ ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror x=messbox(" No comments entered yet. Enter new comment? (y/n) ",1,1,1) if x = 0 if ptstr == "y" x = EnterOrderNotes() ' return 0 - success return (1) else ' repaint & restore top of screen screen shortrestore psa repaint off return (1) end if end if return (-1) else order sort now dictionary "comments.idx" fields "[EnterDate]" descending ordvu_1 = "ordstat4.vw" ordvu_2 = "ordstat2.vw" end if for i = 1 to records ' varndes = ReplaceHardSpace2(date2([EnterDate])&format([Comment],"L75")&[Author]&[Category],90) varndes = ReplaceHardSpace2(date2([EnterDate])&format([Comment],"L75")&"-"&[Author],95) if len(varndes)>1000 messboxwait(" Insufficient space to show Comments - contact DavidC ",0,0,1) return (-1) end if $ordstr = $ordstr&varndes ' "$popstr is:"&str($popstr) data goto record next end for ' #line=10+records #line=9+records vunloadif("comments.vws") while true x = colpoplines(8,1,23,$ordstr,"",1,0,clf,clb,14,3) 'highlight date & press {Enter} to show deliveries if x = -1 exit while end if end while ' screen print #line 4 clf clb " M = Manf'g Complaint : F = Fitting Complaint : I = Awaiting Instruction " ' #line=#line+1 ' screen print #line 4 clf clb "G = Awaiting G'ds : C = Chasing/Statem't : L = Legal : B = Balance Request" ' #line=#line+1 inchar ' fgp = clf ' bgp = clb x = messline(" Enter new comment? (y/n) ",1,1,1,#line,1,99) ' fgp = fgpleasing ' bgp = bgpleasing if x = 0 if ptstr == "y" x = EnterOrderNotes() ' return 0 - success return (1) else ' repaint & restore top of screen screen shortrestore psa repaint off return (1) end if end if END FUNCTION ' ShowOrderNotes() FUNCTION EnterOrderNotes() local l #lenareas #startc #startr $ordnote $cat c1 c2 c3 c4 c5 c6 c7 #cmtdate error off 'select category while true c1 = "ÿÿManf'gÿcomplaint" ' M c2 = "ÿÿFittingÿcomplaint" ' F c3 = "Awaitingÿinstructions" ' I c4 = "ÿÿÿAwaitingÿgoods" ' G c5 = "ÿÿÿREDÿStatements" ' C c6 = "ÿÿÿÿÿÿÿLegal" ' L ' c7 = "ÿÿÿBalanceÿrequest" ' B mbox = scw 'message "mbox is:"&str(mbox) maxmsg=max(len(c1),len(c2),len(c3),len(c4),len(c5),len(c6)) 'message "maxmsg is:"&str(maxmsg) mb=int((mbox-maxmsg)/2)-1 'message "c3) is:"&str(c3) x = popuplist(8,mb,17,c1&c2&c3&c4&c5&c6,"{Esc} to exit",1,0) if x=0 $cat = case ptstr (c1,"M")(c2,"F")(c3,"I")(c4,"G")(c5,"C")(c6,"L")(c7,"B") ' if $cat = "L" ' if $menu <> "boss" ' messboxwait(" Can only be entered by Head Office ",0,0,1) ' continue while ' end if ' elseif $cat = "L" ' BalanceRequest() ' end if exit while elseif x=-1 return (-1) end if end while if $cat="C" $ordnote="RED STATEMENT" else while true x = entryline(" Enter comment for"&ptstr,75,"","",11,4,85) if len(ptstr)=0 continue while end if $ordnote=ptstr exit while end while while true x = fentrybox(" Enter date ",10,"##\/##\/####",today) if x = 0 #cmtdate = ptstr if chkdate(#cmtdate,1) < 0 tone("error") messbox(#cmtdate&"is a bad date! Enter again ",0,0,1) else exit while end if end if end while end if vloadif(dpath|"comments.vws") data enter lock [Job_Nr] =jobnr [EnterDate]=#cmtdate [FileDate] =today [Comment] =$ordnote [Author] =userid [Category] =$cat write-record vunloadif("comments.vws") END FUNCTION ' EnterOrderNotes() function messboxwaitesc(msg,q,c,e) 'D. Lynn ' msg=message q=filter for yes/no (0=no filter,1=filter) ' c=color (0=error colors, 1=pleasing) e=allow escape from "q" filter local fc2 bc2 fc1 bc1 r1 r2 c1 c2 c3 c4 lmsg mbox k err waitmsg waitmsg = " ... press any key to continue " err = 0 k=0 if c=0 fc1=fge bc1=bge fc2=fge bc2=bge else fc1=fgp bc1=bgp fc2=fgi bc2=bgi end if mbox = scrwidth lmsg=len(msg) if lmsg < 30 c4 = int((30-lmsg)/2)+1 msg = repeat("ÿ",c4)|msg|repeat("ÿ",c4) end if lmsg=len(msg) if lmsg + 4 > scrwidth return (-2) end if r1 = scr-2 r2 = scr+2 c3 = int((mbox-lmsg)/2)+1 c1 = c3-2 c2 = c3+lmsg+1 if c1 <= 0 c1 = 1 end if if (c1-1) < 12 while (c1-1) < (scrwidth-c2) c2=c2+1 end while end if if c2 > scrwidth return (-2) end if screen save r1 c1 r2 c2 psa 'ORIGINAL screen clear box r1 c1 r2 c2 fc1 bc1 screen print scr c3 fc2 bc2 msg screen print r2 c2-31 fc1 bc1 waitmsg screen save r1 c1 r2 c2 dsa if q=0 inchar else WHILE "yn" !! k locate scr (c3+lmsg) 1 k=inchar if e=0 and k={Esc} err = -1 exit while end if k = lower(chr(k)) END WHILE locate scr (c3+lmsg) 0 end if screen shortrestore psa if k = 0 ptstr = NULL else ptstr = k end if return (err) end function 'messboxwaitesc() FUNCTION ShowFittings2() local $ftgstr $fname d $ftgstr = "" repaint off vloadif(dpath|"ftr_list.vws") vloadif(dpath|"appntmnt.vws") order change physical data query execute "job_reqn.dfq" index "job_reqn.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' ³ QUERY is: [Job_Nr] = jobnr and not (deleted) ³ ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror messbox(" No appointments for this job ",0,0,1) return (1) end if $dfa1 = "" $ftrappts = "" ' repaint on ' repaint ' message "Check" '--------------------------------------search to remove duplicate days if records > 1 data goto record first for i = 1 to records $dfa1 = left([DFA],11) ' "$dfa1) is:"&str($dfa1) x=chkstr($dfa1,$ftrappts) if x = -1 $ftrappts = $ftrappts&$dfa1 ' "$ftrappts) is:"&str($ftrappts) end if data goto record next end for x=strcount($ftrappts) ' "x is:"&str(x) #ftrappts = ptval ' else $ftrappts = left([DFA],11) #ftrappts = 1 ' end if ' message "$ftrappts is:"&str($ftrappts) redimension ftrarray[#ftrappts] for i = 1 to #ftrappts 'message "$ftrappts is:"&str($ftrappts) d=days(left(group($ftrappts,i),5)) 'message "days is:"&str(d) $day_1 = left(date2(d),10) 'message "$day_1 is:"&str($day_1) $fitter = right(group($ftrappts,i),6) 'message "$fitter) is:"&str($fitter) error off $fname = filelookup([FTR_LIST.Fitter_Code],[FTR_LIST.Nickname],$fitter) 'message "$fname) is:"&str($fname) if cerror ' message "$fname) is:"&str($fname) messbox(" File information corrupt - no details available for this job ",0,0,1) return (1) end if ftrname = ReplaceHardSpace2($fname,len($fname)) $ftgstr = $ftgstr&$day_1|"ÿ"|left(ftrname|"ÿÿÿÿÿÿÿÿ",8)' HARD space ' "MESSAGE "$ftgstr is:"&str($ftgstr) ftrarray[i] = $fitter end for while true x = posncolpopup(4,5,20,$ftgstr,"",1,0,clf,clb,0,7,0) 'highlight date & press {Enter} to show deliveries $ftrdate=date2(left(ptstr,10)) if x = -1 repaint off exit while end if screen shortrestore dsa $ftrcode = ftrarray[ptval] ShowDeliveries() vloadif(dpath|"appntmnt.vws") end while vunloadif("appntmnt.vws") vunloadif("delivr_1.vw") vunloadif("ftr_list.vws") END FUNCTION ' ShowFittings2() FUNCTION ShowInvoice() if len($invnr)=0 messboxwait(" Not yet invoiced ",0,0,1) return (-1) end if ' message "$invnr is:"&str($invnr) $pdf=invpath|$invnr|".pdf" 'message "$pdf is:"&str($pdf) if file($pdf) = TRUE _GEMS_ShellEx("open",$pdf,"",1) else messboxwait("L2474\ Invoice `"|$invnr|"' not found - report to Office ",0,0,1) screen clear box 1 1 sch scw 0 0 no-border repaint off end if END FUNCTION ' ShowInvoice() FUNCTION StreetMap() local $p_code if len(trim(deladdr4))=0 _GEMS_WinDialog("Delivery postcode not yet entered","ERROR",16) deladdr4=_GEMS_Input("Delivery Postcode","Enter or update",trim(deladdr4),8,0,"") end if $p_code=deladdr4 'message "$p_code) is:"&str($p_code) $p_code=replacestr($p_code," ","+") 'message "$p_code) is:"&str($p_code) $url="www.streetmap.co.uk/streetmap.dll?postcode2map?"|$p_code|chr(32) _GEMS_Web($url) END FUNCTION ' StreetMap() FUNCTION BalReqst() vloadif(dpath|"inv_1.vw") order change key "[Job_Nr]" data find "[Job_Nr]" equal jobnr options "" if cerror ' if none - then return messboxwait(" Job Nr"&jobnr&"not found ",0,0,1) return (1) end if if [Balance_Due]<1 ' no balance O/S messboxwait(" No Balance Outstanding ",0,0,1) return (1) end if x=PrintRequest() if x = -1 repaint off return (-1) end if END FUNCTION ' BalReqst() FUNCTION PrintRequest() Background() $index="onlyone.idx" $file="cust_ord" remove($index) x = makeidx($file,$index,str(precord),3) ' message "x is:"&str(x) order change index $index remove(X_path|"X_inv_a.*") data query execute "not_del.dfq" Smart4 X_path|"X_inv_a" fields "[1|"|str(dbinfo(db_fields))|"]" vunloadif("X_inv_a.vws") vloadif(dpath|"variat_n.vws") ' remove(X_path|"X_inv_b.*") ' data query execute "allVreqn.dfq" Smart4 X_path|"X_inv_b" fields "[1|"|str(dbinfo(db_fields))|"]" ' vunloadif("X_inv_b.vws") _SWIP_Crystal(Xreppath|"balreqst","S",0,1,"") vloadif(dpath|"comments.vws") data enter lock [Job_Nr] =jobnr [EnterDate]=today [Comment] ="Balance request letter" [Author] =userid [Category] ="B" write-record vunloadif("comments.vws") vunloadif("inv_1.vw") END FUNCTION ' PrintRequest() ' function Emails() ' ' $emailaddress=EnterEmailAddress($emailaddress) ' ' _GEMS_Email($emailaddress,$ownemail,"Test","Test from DavidC at"&left(time,5),"") ' ' end function 'Emails() ' FUNCTION EnterEmailAddress(cem) ' local j r i n x $mess ' ' $email="" ' while true ' if len(cem)=0 ' $mess="Email address not yet held" ' else ' $mess="Update if necessary" ' end if ' $email=_GEMS_Input("Email Address",$mess,cem,50,6,"") 'message "$email is:"&str($email) ' ' if left($email,1)="@" ' messboxwait(" Invalid email address - 1st char is @ ",0,0,1) ' continue while ' end if ' ' if right($email,1)="." ' messboxwait(" Invalid email address - last char is . ",0,0,1) ' continue while ' end if ' ' if right($email,1)="@" ' messboxwait(" Invalid email address - last char is @ ",0,0,1) ' continue while ' end if ' ' for j=1 to len($email) ' r = mid($email,j,1) ' message "r is:"&str(r) ' if r=chr(64) ' exit while ' end if ' end for ' messboxwait(" Invalid email address format - no @ sign ",0,0,1) ' ' end while ' $emailaddress=$email ' vloadif(dpath|ordvu_1) ' if [Job_Nr]<>jobnr ' ' messboxwait(" Printing SAT note for ",0,0,1) ' return ($emailaddress) ' end if ' lock-record ' [Email_Addr]=$email ' write-record ' return ($emailaddress) ' END FUNCTION 'EnterEmailAddress() FUNCTION ShowDeliveries() local y6 #thisvisit repaint off vloadif(dpath|"delivr_2.vw") order change key "[Job_Nr]" data query execute "jobsheet.dfq" index "sd1.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Job_Nr] = jobnr ' and ' [Itemtype] <> "O" ' and ' not(deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror screen shortrestore psa messboxwait(" NO deliveries booked ",0,0,1) return (1) end if data query execute "showdel1.dfq" index "sd2.idx" ' "$ftrdate) is:"&str($ftrdate) ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Date_Out] = $ftrdate ' and ' [Fitter_Code]=$ftrcode ' and ' not(deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror screen shortrestore psa messboxwait(" NO deliveries booked for"&$ftrdate,0,0,1) return (1) end if remove(X_path|"X_ftrout.*") data query execute "not_del.dfq" Smart4 X_path|"X_ftrout" fields \ "[Job_Nr;Date_Out;Product_MRC;Description_MRC;QuantOut;Cost;Width;Fitter_Name;CustOrd_Name;Delivery_Address_1;Delivery_Address_2;Del_City;Del_Postcode;Balance_Due;Instructions;Fitting_Comment;Customer_Code;Itemtype]" vunloadif("X_ftrout.vws") remove(X_path|"Xftrout1.*") vloadif(dpath|"delivr_3.vw") order change key "[Customer_Code]" data query execute "statmnt2.dfq" Smart4 X_path|"Xftrout1" fields "[Customer_Code;Customer_Name;Contact_Name;Home_Tel;Office_Tel;Mobile/Other_Nr;Credit_Status;Title]" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Customer_Code] = custcode ' and ' not (deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror screen shortrestore psa messboxwait(" NO deliveries booked ",0,0,1) return (1) end if vunloadif("Xftrout1.vws") _SWIP_Crystal(Xreppath|"X_ftrout","S",0,1,"") END FUNCTION ' ShowDeliveries() FUNCTION ShowAllReqs() local y2 y1 y3 y4 progress(15,10," Please wait ... finding requisitions ",0) repaint off vloadif(dpath|"gds_rcvd.vws") vloadif(dpath|"supplier.vws") vloadif(dpath|"purchord.vws") vloadif(dpath|"all_reqn.vw") order change key "[JobNr]" data query execute "all_reqn.dfq" index "all_req1.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' ³ QUERY is: [Job_Nr] = jobnr ³ ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror return (1) else ' order by ListOrder & prodMRC order sort now dictionary "all_reqn.idx" fields "[Lst_Stck;Product_MRC]" ascending #count = records repaint on repaint screen shortrestore S_all end if ptval=0 while true ptval = NavReqns() if ptval = {Esc} repaint off vunloadif("gds_rcvd.vws") vunloadif("supplier.vws") vunloadif("purchord.vws") vunloadif("all_reqn.vw") screen clear box 7 1 sch scw 0 0 no-border return (-1) end if end while repaint off END FUNCTION ' ShowAllReqs() FUNCTION ShowArcReqs() local y2 y1 y3 y4 progress(15,10," Please wait ... finding requisitions ",0) repaint off vloadif(dpath|"a_allreq.vw") order change key "[Job_Nr]" data query execute "a_allreq.dfq" index "all_req1.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ' [Job_Nr] = jobnr ' and ' not(deleted) ' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ if cerror screen shortrestore psa x = remove("all_reqn.idx") ' create temp index for allocation x = makeidx("requsn","all_reqn.idx","0",1) if x = -1 message "L1455\ makeidx() failed" end if messboxwait(" NO requisitions entered ",0,0,1) return (1) else ' order by ListOrder & prodMRC order sort now dictionary "all_reqn.idx" fields "[Lst_Stck;Product_MRC]" ascending #count = records repaint on repaint screen shortrestore S_all end if ptval=0 while true ptval = NavReqns() if ptval = {Esc} repaint off vunloadif("gds_rcvd.vws") vunloadif("supplier.vws") vunloadif("purchord.vws") vunloadif("a_allreq.vw") screen clear box 7 1 sch scw 0 0 no-border return (-1) end if end while repaint off END FUNCTION ' ShowArcReqs() ' FUNCTION EnterEmailAddress() ' local j r i n ' message "L2740 $email) is:"&str($email) ' if len($email)=0 ' $email="" ' end if ' while true ' x = fentrybox(" Enter email address (max 50 characters) - {Esc} to exit ",50,$email,"") ' if x = -1 ' exit while ' end if ' $email = ptstr ' ' message "Input $email is:"&str($email) ' ' if left($email,1)="@" ' messboxwait(" Invalid email address - 1st char is @ ",0,0,1) ' continue while ' end if ' if right($email,1)="." ' messboxwait(" Invalid email address - last char is . ",0,0,1) ' continue while ' end if ' ' if right($email,1)="@" ' messboxwait(" Invalid email address - last char is @ ",0,0,1) ' continue while ' end if ' ' for j=1 to len($email) ' r = mid($email,j,1) ' message "r is:"&str(r) ' if r=chr(64) ' message "checked $email is:"&str($email) ' exit while ' ' continue while ' end if ' end for ' messboxwait(" Invalid email address format - no @ sign ",0,0,1) ' end while ' ' message "SO3 L838 checked $email is:"&str($email) ' END FUNCTION ' EnterEmailAddress() FUNCTION EnterEmailAddress() ' from L470 local j r i n x $mess ' message "MO L1309 $email) is:"&str($email) if len($email)=0 $email="" end if while true while true x = fentrybox(" EMAIL address - {Esc} if none ",50,"",$email) if x = 0 $email=ptstr exit while else $email = "" return (0) end if end while messbox(" Confirm"&$email|"? (y/n) ",1,1,1) if ptstr == "n" continue while else exit while end if ' temporary rem out until keyboard mapping corrected ' if left($email,1)="@" ' messboxwait(" Invalid email address - 1st char is @ ",0,0,1) ' continue while ' end if ' if right($email,1)="." ' messboxwait(" Invalid email address - last char is . ",0,0,1) ' continue while ' end if ' if right($email,1)="@" ' messboxwait(" Invalid email address - last char is @ ",0,0,1) ' continue while ' end if ' for j=1 to len($email) ' r = mid($email,j,1) ' message "r is:"&str(r) ' if r=chr(64) ' exit while ' end if ' end for ' messboxwait(" Invalid email address format - no @ sign ",0,0,1) end while END FUNCTION 'EnterEmailAddress() FUNCTION ViewCtgPlan() local $new single-step off Background() repaint off x=remove("C:\SW2K_NEW\programs\ctgplan1.txt") 'message "remove x) is:"&str(x) error off ' message "jobnr is:"&str(jobnr) $br=left(jobnr,1) $branch=case $br ("S","Sheen")("W","Warehouse")("P","Putney")("F","Fulham")("R","Raynes") ' message "$branch) is:"&str($branch) ' tools os "dir V:\Fulham\F23299*.pdf /O:N /B > C:\SW2K_NEW\programs\ctgplan.txt" quiet on x="V:\"|$branch|"\"|jobnr|"*.pdf" 'message "x) is:"&str(x) tools os "dir V:\"|$branch|"\"|jobnr|"*.pdf /O:N /B > C:\SW2K_NEW\programs\ctgplan1.txt" ' message "chk text file" if len("ctgplan1.txt")<1 messboxwait(" No ctg plan found for"&jobnr,0,0,1) return (0) else messboxwait(" Showing Cutting Plans for"&jobnr,0,0,1) end if fopen "C:\SW2K_NEW\programs\ctgplan1.txt" as 1 $new="Y" while eof(1) = 0 fread 1 into $pdfstr 'message "$pdfstr) is:"&str($pdfstr) if len($pdfstr)=0 if $new="Y" messboxwait(" No ctg plan found for"&jobnr,0,0,1) end if fclose 1 return (0) end if $pdf="V:\"|$branch|"\"|$pdfstr 'message "$pdf is:"&str($pdf) if file($pdf) = TRUE _GEMS_ShellEx("open",$pdf,"",1) $new="N" else messboxwait("Cutting Plan `"|$pdf|"' not found - report to Office ",0,0,1) Background() exit while end if end while fclose 1 END FUNCTION ' ViewCtgPlan()