'DEL_ONLY - Supply/Delivery orders - routine to check goods out '10/11/95 - SelectReqns (L675) was rem'd out. Program was printing the whole ' req'n file external vloadif() sch scw messbox() fentrybox() dpath cpath shopmask nr5 external fgp userid scr dsa strtoary() arytostr() vkeybox() $enternow external remove() makeidx() bgp fgi bgi progress() PrintReport() external lpath bge popuplist() city wraptext() #maxleft #minleft messboxwait() external entryline() messline() strcount() posnpopup() jobnr jobs[6] shopname external vunloadif() ipath base navrecs() bpopdb() chkdate() Background() external addidxrec() delidxrec() getidxrecs() delstr() external to_busdate() colmessbox() $menu public #start #end #days ptstr ptval psa ptary[1] plist[1,1] $cust public ftgdate $ref custname $collector global x startdate enddate y #recs i y1 y2 y3 col z ProcessCollection() global $date $dow $dfa $name $a1 $a2 $a3 $a4 $a5 $a6 $a7 w $comment r1 global $slotsrem #slotsrem #apptslots $jobstr sd c global $popstr ftrname #appt $appth deladdr1 title1 ProcessItem() Titles() global spc $pl EnterFittingDate() g fgc bgc EnterCollector() global z1 z2 z3 z4 z5 z6 z7 z8 $ftrcode n #prec #rec #count global drows pl t rec recs lc sc sym mr blen l c2 r2 dc pc k pg tr global namelist[1,1] $idx $stat $dely $esc AlreadyCollected() global prodMRC #del_cost #rem_len #refnr $ordstat #bline $mess global refcode #rem_cost $daynr $ftgnr $col1 global ReqnDeliveryDates() CheckDay() $status global ClearFtgDateReqns() $b1 $b2 $b3 $b4 $b5 $b6 $b7 CheckSupplyDely() DeliveryDate() global EnterJobNr() ReturnToMenu() PrintDespatch() $col global p1 p2 p3 p4 p5 p6 MAIN single-step off screen clear box 1 1 sch scw 0 0 no-border repaint off messboxwait(" Program not currently in use ",0,0,1) p1 = "collectn.dfr" ' p1 = report definition ("ord_stck.dfr") p2 = "" ' p2 = title at top of choice popup ("LABEL") p3 = 1 ' p3 = printer to be used (1=HPIII_QC; 2=GEN_EPSN etc) p4 = 1 ' p4 = printer port to use (1,2 etc - network set to use 2=LASER; 3=LABEL) p5 = 1 ' p5 = choose VIEW/PRINT 1=PRINT; 2=VIEW; 3=CHOOSE p6 = 1 ' p6 = nr of copies while true file unload all clear global if $menu <> "boss" messboxwait(" Program superceded - use new Collections routine ",0,0,1) screen clear box 1 1 sch scw 0 0 no-border repaint off exit while end if x = EnterJobNr() ' find Cust_Ord & update - L691 if x = -1 screen clear box 1 1 sch scw 0 0 no-border repaint off exit while end if end while ReturnToMenu() END MAIN FUNCTION CheckSupplyDely() vloadif(dpath|"salord04.vw") ' check for supply/delivery only if left([Description],6) = "Supply" return (0) end if if left([Description],8) = "Delivery" return (0) end if return (1) END FUNCTION 'CheckSupplyDely() FUNCTION PrintDespatch() local p1 p2 p3 p4 p5 p6 p1 = "delivery.dfr" ' p1 = report definition ("ord_stck.dfr") p2 = "" ' p2 = title at top of choice popup ("LABEL") p3 = 1 ' p3 = printer to be used (1=HPIII_QC; 2=GEN_EPSN etc) p4 = 1 ' p4 = printer port to use (1,2 etc - network set to use 2=LASER; 3=LABEL) p5 = 1 ' p5 = choose VIEW/PRINT 1=PRINT; 2=VIEW; 3=CHOOSE p6 = 1 ' p6 = nr of copies x=PrintReport(p1,p2,p3,p4,p5,p6) END FUNCTION ' PrintDespatch() FUNCTION ReturnToMenu() lock module jobnr screen clear box 1 1 sch scw 0 0 no-border repaint off error off while true window close if cerror exit while end if end while file unload all transfer cpath|"pm_menu.psl" in-memory END FUNCTION FUNCTION EnterJobNr() ' finds Job & updates Cust_Ord local l1 c3 c2 c1 ques $reqstr fj while true screen clear box 1 1 sch scw 0 0 no-border repaint off smartpoke $_ins 0 while true x = fentrybox(" Enter Order Nr for Delivery; {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 vloadif(dpath|"salord04.vw") order change key "[Job_Nr]" data find "[Job_Nr]" equal jobnr options "g" ' find correct JOB if cerror messboxwait(" Job Nr -"&jobnr&"- NOT found ",0,0,1) return (-1) end if repaint off exit while end while custname = [Customer_Name] $ref = [CustOrd_Name] while true Background() ' x = popuplist(9,33,13,"˙Previous ˙˙˙New","Collections",1,0) x = popuplist(9,33,13,"˙Previous ˙˙˙New",jobnr,1,0) if x = 0 if ptstr = "˙Previous" x = AlreadyCollected() continue while else x = CheckSupplyDely() if x = 1 messboxwait(" NOT Supply/Delivery ONLY ",0,0,1) continue while end if vunloadif("salord04.vw") EnterFittingDate() EnterCollector() x = ReqnDeliveryDates() if x <> 0 continue while end if PrintDespatch() end if elseif x = -1 exit while end if end while end while END FUNCTION ' EnterJobNr() FUNCTION AlreadyCollected() local sr progress(15,1," Finding collected requisitions .... ",0) repaint off vloadif(dpath|"collectd.vw") order change key "[Job_Nr]" data query execute "job_reqn.dfq" index "x1.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŋ ' [Job_Nr] = jobnr ' and ' not(deleted) ' ĀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŲ if cerror messboxwait(" No requisitions for this job ",0,0,1) return (1) end if 'query for delivered data query execute "collectd.dfq" index "x3.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŋ ' [Status] = "C" ' ĀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŲ if cerror messboxwait(" No requisitions for this job ",0,0,1) return (1) end if order sort now dictionary "collectd.idx" fields "[Expect_Fitting_Date]" descending repaint on repaint ptval=0 y1 = format(" Collections for"&custname,"M80") y2 = format(" {Esc} to continue ","M80") screen print 2 1 fgp bgp y1 screen print 22 1 fgp bgp y2 while true ptval = navrecs() if ptval = {Esc} Background() exit while end if end while END FUNCTION ' AlreadyCollected() FUNCTION ReqnDeliveryDates() local sr progress(15,1," Processing requisitions .... ",0) repaint off vloadif(dpath|"del_only.vw") order change key "[Job_Nr]" data query execute "reqn_del.dfq" index "del_only.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŋ ' [Job_Nr] = jobnr ' and ' [Expect_Fitting_Date]=blank ' and ' not(deleted) ' ĀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŲ if cerror messboxwait(" No undelivered requisitions for this job ",0,0,1) return (1) end if if cerror #refnr = 0 end if data query execute "del_only.dfq" index "job_appt.idx" ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŋ ' [Item_Type] <> "O" ' and ' not(deleted) ' ĀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŲ if cerror return (1) end if x = ProcessCollection() if x = -1 return (-1) end if END FUNCTION ' ReqnDeliveryDates() FUNCTION EnterFittingDate() ' n=2 Select; n=0/1 Do not select while true x = fentrybox(" Enter Delivery Date ",10,"##\/##\/####",today) if x = 0 ftgdate = ptstr if chkdate(ftgdate,1) = -1 messbox(" Incorrect date - re-enter ",0,0,1) continue while end if if days(ftgdate) < days(today) messboxwait(" Can ONLY book out for today or future dates ",0,0,1) continue while end if exit while else continue while end if end while END FUNCTION ' EnterFittingDate() 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 ClearFtgDateReqns() ' local fd ' 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 ' messboxwait(" No requisitions entered for this job ",0,0,1) ' return (0) ' end if ' data query execute "reqnno_J.dfq" index "job_appt.idx" ' ' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŋ ' ' [Item_Type] <> "O" ' ' and ' ' not(deleted) ' ' ĀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŲ ' if cerror ' return (0) ' end if ' data goto record first ' error off ' for fd = 1 to records ' if days(date2([Expect_Fitting_Date])) > days(today) ' lock-record ' [Expect_Fitting_Date]=blank ' [Ftr_Code] = "" ' write-record ' end if ' data goto record next ' end for END FUNCTION ' ClearFtgDateReqns() FUNCTION DeliveryDate() local fd ' alter Expect_Fitting_Date in REQUSN vloadif(dpath|"entappt4.vw") data goto record first error off for fd = 1 to records if days(date2(namelist[fd,4])) > 0 lock-record [Expect_Fitting_Date]=date2(namelist[fd,4]) [Ftr_Code] = "NON999" [Status] = "F" write-record else lock-record [Expect_Fitting_Date]=blank [Ftr_Code] = "" write-record end if data goto record next end for END FUNCTION 'DeliveryDate() FUNCTION ProcessCollection() local $delrecs x = remove("collectn.idx") if x = -1 ' message "remove() failed" end if x = makeidx("requsn","collectn.idx","0",1) if x = -1 ' message "makeidx() failed" end if Titles() ptval=0 while true ptval = navrecs() if ptval = {C} or ptval = {c} if [RollNr]="00000/00" or [RollNr]="BESPOK" messbox(" Not yet received/allocated ",0,0,1) continue while end if x = ProcessItem() if x = 1 continue while end if if x = 0 data goto record next continue while elseif x = -1 continue while end if elseif ptval = {F10} repaint off ' create INV_LIST data goto record first $comment = "Collector:"|$collector for i = 1 to records if [Cut] = "¯" x = addidxrec("collectn.idx",precord,7) ' add to temp index lock-record [Cut] = "" [Expect_Fitting_Date] = ftgdate [Created/Changed_By] = userid [Comment] = $comment write-record end if data goto record next end for x = getidxrecs("collectn.idx",2) if x = 0 if ptval = 0 messbox(" No req'ns selected - use {Esc} to abandon ",0,0,1) continue while end if end if order change index "collectn.idx" return (0) ' temp elseif ptval = {Esc} repaint off data goto record first for i = 1 to records 'message "Clear check mark from all supp_inv.idx items" if [Cut] = "¯" lock-record [Cut] = "" write-record end if data goto record next end for screen clear box 1 1 sch scw 0 0 no-border data goto record first return (-1) end if end while END FUNCTION ' ProcessCollection() FUNCTION ProcessItem() if [Cut] = "¯" lock-record [Cut] = "˙" write-record else lock-record [Cut] = "¯" write-record end if return (0) END FUNCTION ' ProcessLineItem() FUNCTION Titles() y1 = format(" Collections for"&custname&"("|jobnr|")","M72") y3 = format(" ˙˙Description Colour Length RollNr ","L72") repaint on repaint screen print 5 5 15 12 y1 screen print 6 5 fgp bgp y3 y2 = format(" ¯ = add/remove for {C}ollection - {F10} finishes - {Esc} restarts","M72") screen print 21 5 fgp bgp y2 END FUNCTION 'Titles() FUNCTION EnterCollector() while true x = fentrybox(" Name of person collecting ",10,"","") if x = -1 continue while end if if ptstr = "" continue while end if $collector = ptstr messbox(" Collected by"&$collector|"? (y/n) ",1,1,1) if ptstr == "Y" exit while else continue while end if end while END FUNCTION ' EnterCollector()