'QUIKREPT based on TRADEORD.PF3 external messbox() fentrybox() dpath vloadif() sch scw cpath shopmask nr5 external fgp userid scr dsa remove() vkeybox() $enternow ipath bgp invpath external lpath bge popuplist() city wraptext() #maxleft #minleft messboxwait() external entryline() messline() strcount() posnpopup() jobs[6] shopname bgi external bpopdb() increment() Background() progress() vunloadif() addidxrec() external makeidx() bbd fdp nr6 navrecs() delidxrec() vatrate external delstr() colpopup() findcolpop() strtoary() chkstr() chkdate() bgs external Exception() fgi fgs cr_warn nr8 $menu external X_path _SWIP_Crystal() Xreppath public ptstr ptval jobnr prodcode public plist[1,1] #refnr $screen psa custref #varngross docref strt_date end_date mthname global Title_C() r1 r2 c1 c2 x y1 y2 ReturnToMenu() y global $itemtype $rollnr prodMRC #prodrec global y3 s_shwreq $prodend global strtcol recs $popstr #nritems strtrow keyf keyb f1 f2 f3 f4 global clearvar() x1 x2 l1 l2 c3 Date() global $popcol PrintResults() global mr blen rec drows pg tr #unused global CheckPrice() Title_A1() MAIN local uc ar1 ar2 single-step off Background() file unload all keyf = 7 keyb = 0 prodcode = "" while true x=Date() if x = -1 exit while end if while true x=CheckPrice() if x = -1 exit while end if end while end while ReturnToMenu() END MAIN FUNCTION PrintResults() repaint off vloadif(dpath|"reqntots.vw") order change index "reqns1.idx" data query execute "findreqn.dfq" index "reqns2.idx" ' 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 ' [Product_Code] = prodcode ' and ' not (deleted) ' 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 if cerror messboxwait(" No records found in selected period for"&prodMRC|" ",0,0,1) return (1) end if vunloadif("reqntots.vws") remove(X_path|"reqntots.*") data query execute "not_del.dfq" Smart4 X_path|"reqntots" fields\ "[Date_Requisitioned;Product_Code;Product_MRC;Description_MRC;Job_Nr;Length_Quantity;Width;start_D;end_D;#area]" _SWIP_Crystal(Xreppath|"reqntot2","S",0,1,"") vunloadif("reqntots.vw") END FUNCTION 'PrintResults() FUNCTION Date() local y mth ld last_m_e strt_date="01"|right(date2(days(today)-30),8) ' message "strt_date) is:"&str(strt_date) while true x = fentrybox(" Enter START Date for Summary ",10,"##\/##\/####",strt_date) if x = 0 strt_date = ptstr if chkdate(strt_date,1) = -1 messbox(" Incorrect date - re-enter ",0,0,1) continue while end if elseif x = -1 return (-1) end if mth = right(date2(strt_date),7) for ld = 31 to 28 step -1 last_m_e = str(ld)|"/"|mth 'message "last_m_e is:"&str(last_m_e) if chkdate(last_m_e,1) = -1 continue for else exit for end if end for end_date=last_m_e mthname=monthname(strt_date) x = fentrybox(" Enter �END� Date for Summary ",10,"##\/##\/####",end_date) if x = 0 end_date = ptstr if chkdate(end_date,1) = -1 messbox(" Incorrect date - re-enter ",0,0,1) continue while end if exit while elseif x = -1 return (-1) end if end while progress(15,10," Please wait . . . . . finding requisitions ",1) vloadif(dpath|"requsn.vws") order change physical data query execute "crplst10.dfq" index "reqns1.idx" ' 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 ' days([Date_Requisitioned])>=days(strt_date) ' and ' days([Date_Requisitioned])<=days(end_date) ' and ' not (deleted) ' 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 if cerror messboxwait(" No records found for these dates ",0,0,1) Background() return (0) end if Background() END FUNCTION 'Date() FUNCTION CheckPrice() local z #deflen $wrongprod f1 f2 f3 nr_reqns nr_index ' upd_new = "NEW" Title_A1() repaint off ptval=0 while true Title_A1() prodcode = "" x = inchar 'message "x is:"&str(x) if x = 317 'F3 - Bespoke Carpet - IT = "B" $prodend = "B" while true 'bpop must show Supplier name, Suppcode & Backing clearvar() vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"bespcarp.idx" if prodcode = "" y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) else data goto record record-number #prodrec y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72") screen print 21 5 fgp bbd y2 x=bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) end if if x = -1 repaint off vloadif(dpath|"prodsel"|$prodend|".vw") ' MESSAGE "L190\ should go back to showing choice of F#" Background() exit while end if #prodrec = record prodcode = ptstr ' message "prodcode -L1489- is:"&str(prodcode) ' $backing = [Backing] ' $uos = [Unit_Of_Sale] ' message "$uos is:"&str($uos) screen shortrestore dsa $itemtype = [Item_Type] prodMRC = [Product_MRC] 'message "L220\ prodcode is:"&str(prodcode) x=PrintResults() Title_A1() ' Background() vloadif(dpath|"prodsel"|$prodend|".vw") continue while end while elseif x = 318 ' F4 - Stock Ancl - IT = "A" $prodend = "A" while true ' bpop must show Supplier name, Suppcode & Backing clearvar() vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"stckancl.idx" if prodcode = "" y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72") y2 = format("Scroll to select or {Esc} to leave","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) else data goto record record-number #prodrec ' y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72") y2 = format("Scroll to select or {Esc} to leave","M72") screen print 21 5 fgp bbd y2 x=bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) end if if x = -1 repaint off vloadif(dpath|"prodsel"|$prodend|".vw") ' MESSAGE "L228\ should go back to showing choice of F#" Background() exit while end if #prodrec = record prodcode = ptstr ' message "prodcode -L1489- is:"&str(prodcode) ' $backing = [Backing] ' $uos = [Unit_Of_Sale] ' message "$uos is:"&str($uos) screen shortrestore dsa $itemtype = [Item_Type] prodMRC = [Product_MRC] 'message "L220\ prodcode is:"&str(prodcode) x=PrintResults() Title_A1() vloadif(dpath|"prodsel"|$prodend|".vw") continue while end while elseif x = 319 ' F5 - Bespoke Ancl - IT = "J" $prodend = "B" while true ' bpop must show MRC name (& Backing?) & Suppcode clearvar() vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"bespancl.idx" ' message "F5 - prodcode is:"&str(prodcode) if prodcode = "" ' y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72") y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72") screen print 21 5 fgp bbd y2 x=bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) else data goto record record-number #prodrec y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x=bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) end if if x = -1 repaint off vloadif(dpath|"prodsel"|$prodend|".vw") Background() exit while end if #prodrec = record prodcode = ptstr ' message "prodcode -L1489- is:"&str(prodcode) ' $backing = [Backing] ' $uos = [Unit_Of_Sale] ' message "$uos is:"&str($uos) screen shortrestore dsa $itemtype = [Item_Type] prodMRC = [Product_MRC] 'message "L220\ prodcode is:"&str(prodcode) x=PrintResults() Title_A1() vloadif(dpath|"prodsel"|$prodend|".vw") continue while end while elseif x = 320 ' F6 - Vinyl - IT = "V or W" $prodend = "B" while true clearvar() vloadif(dpath|"prodsel"|$prodend|".vw") order change index ipath|"vinyl.idx" ' bpop must show MRC ?????????????? if prodcode = "" y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) else data goto record record-number #prodrec y2=format(" Scroll or press {F3} to search - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x=bpopdb("prodsel"|$prodend,4,"i","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) end if if x = -1 repaint off vloadif(dpath|"prodsel"|$prodend|".vw") Background() exit while end if #prodrec = record prodcode = ptstr ' message "prodcode -L1489- is:"&str(prodcode) ' $backing = [Backing] ' $uos = [Unit_Of_Sale] ' message "$uos is:"&str($uos) screen shortrestore dsa $itemtype = [Item_Type] prodMRC = [Product_MRC] 'message "L220\ prodcode is:"&str(prodcode) x=PrintResults() Title_A1() vloadif(dpath|"prodsel"|$prodend|".vw") continue while end while elseif x = 321 ' F7 - Tiles - IT = "S or T" $prodend = "B" while true clearvar() vloadif(dpath|"prodsel"|$prodend|".vw") x = popuplist(20,59,25,"Stock Bespoke","",1,0) if x = -1 Background() exit while end if if ptstr = "Stock" order change index ipath|"stk_tile.idx" ' bpop must show MRC ?????????????? else order change index ipath|"bsp_tile.idx" ' bpop must show MRC ?????????????? end if if prodcode = "" y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) else data goto record record-number #prodrec y2 = format(" Scroll or press {F3} to search - {Esc} to leave ","M72") screen print 21 5 fgp bbd y2 x = bpopdb("prodsel"|$prodend,4,"i","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0) end if if x = -1 repaint off vloadif(dpath|"prodsel"|$prodend|".vw") Background() exit while end if #prodrec = record prodcode = ptstr ' message "prodcode -L1489- is:"&str(prodcode) ' $backing = [Backing] ' $uos = [Unit_Of_Sale] ' message "$uos is:"&str($uos) screen shortrestore dsa $itemtype = [Item_Type] prodMRC = [Product_MRC] 'message "L220\ prodcode is:"&str(prodcode) x=PrintResults() Title_A1() vloadif(dpath|"prodsel"|$prodend|".vw") continue while end while elseif x = 763 ' {Esc} - if no records then abandon Background() return (-1) else clearvar() continue while end if end while data goto record last return (0) END FUNCTION ' CheckPrice() FUNCTION Title_A1() y2 = format("Select requisition type or {Esc} to exit","M72") screen print 21 5 fgp bbd y2 screen save 5 5 21 77 s_shwreq repaint off Title_C() END FUNCTION 'Title_A1() 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 Title_C() f1 = format("���������� F3 � F4 � F5 � F6 � F7 � ","L80") f2 = format("���������� Bespoke � Stock � Bespoke � Vinyls � Tiles � ","L80") f3 = format("�������� � Carpet � Ancll'y � Ancll'y � � � ","L80") f4 = format("Using records from"&date2(strt_date)&"to"&date2(end_date),"M72") screen print 22 1 keyf keyb f1 screen print 23 1 keyf keyb f2 screen print 24 1 keyf keyb f3 screen print 25 5 fgp bbd f4 END FUNCTION 'Title_C() FUNCTION clearvar() ' clear #ordlength ' clear ordref ' clear orderby ' clear purchorderdate ' clear delquot ' clear specterm clear prodMRC clear $itemtype ' clear #reqncost ' clear $comment ' clear #ordwidth ' clear $ccwcode clear $rollnr ' clear $backing ' clear $smlc ' clear $smlr ' clear $prev_C ' clear $prev_R ' clear $effecdate ' clear $disc ' clear prodSUPP ' clear #unitcost ' clear #addn END FUNCTION 'clearvar()