#include Prod.Product #include BL.Prod PRODUKT6 ;PRODUCTEN [ 09/29/2003 11:47 AM ] d ^cA604 s R=$$SELECT() w @F11,@F1,R Q ;Selecteren van een product ;LimT : Limiet Type : KL=Klas,L=Leverancier,K=Klant ;LimV : Limiet value : KlasKey of LevNr of KlantNr ;DefInp : Optie : Default input: een korttekst, identnummer of dossiernummer ;Titel : Optie : prompting voor ingave ;Opties [ "NODO" : Geen direct order-producten toegelaten (identnr begint met 7) ;Opties [ "NOKP" : Geen kind-producten toegelaten (identnr begint met 6) ;Opties [ "ALL" : Alle producten ook non-active ;ExtKom : Extra kommentaar (enkel voor beperkte lijst) ;EntExit : Geen lijst bij leeg inputveld en ENTER maar geef leeg terug ;NoInput : Geen input - bij oproep vanuit bvb EXEL ;PoolKLNr : Via een klantnummer legt men een beperking op industrie of KS, via + krijgt men alles ;ShowLT : Al of niet tonen van de langtekst op de 2 onderste lijnen ; N.B. Als product A een match is op vlak van identnr en B een match op vlak van korttekst of leveranciersref, zal deze routine je niet laten kiezen! SELECT(LimT,LimV,DefInp,Titel,Opties,ExtKom,EntExit,NoInput,PoolKLNr,ShowLT) New Tekst,PRNr,PR,PRV,PRI,IPR,NotFound,X,Y,VPR,PRT,K,DefPR,KLNr,LEVNr,KKey,KHS,KGS,KSS,Niv,GenTyp,IsKS,NoDo,NoKP,AfterPrompt,MemPoolKLNr,PlusKey,blSearch,pxCriteria,IsKSCust New:$G(PoolKLNr)=7587 PoolKLNr ; Voor Halux geen beperking Set (LimO,LimT)=$G(LimT),LimV=$G(LimV),%SelProd("Via")=$G(%SelProd("Via"),"Z"),ShowLT=$G(ShowLT),(PoolKLNr,MemPoolKLNr,PlusKey)=$G(PoolKLNr) Set:PoolKLNr IsKSCust=$$IsKSKlant(PoolKLNr) Set blSearch=##class(BL.Prod.Search).%New() If '$L(LimO) Do ;Defaulting old setting .Set LimT=$P($G(sRef("SELPR")),D,1) .Set LimV=$P($G(sRef("SELPR")),D,2) Set DefInp=$G(DefInp),Opties=$G(Opties),ExtKom=$G(ExtKom),EntExit=$G(EntExit),NoInput=$G(NoInput) Set:'NoInput Tekst=$S($P(^cLOG(boot,"DEV",$$IO^cQ5),"\")="MC":"PageUp",1:"SEL") If '$L($G(Titel)) Set Titel="Product : " Do ADD^vhScherm(21,24) Set PRNr="",PR=$E($G(%SelProd("Korttekst")),1,20) If $L(DefInp),$E(DefInp,$L(DefInp))'="*" Set PR=DefInp,zb=0 If $L(DefInp),$E(DefInp,$L(DefInp))="*" Set PR=$E(DefInp,1,$L(DefInp)-1),DefInp="" SEL2 If '$L(DefInp),'NoInput Do . Set FP=21-(ShowLT*2)*100+1 . Write @F,@F1 . Set AfterPrompt="" . Set:MemPoolKLNr AfterPrompt=$S(PoolKLNr:" Beperkt tot "_$S(IsKSCust:"KS",1:"IP")_" (druk +[] voor alles)",1:" Geen "_$S(IsKSCust:"KS",1:"IP")_" beperking (druk +[] voor beperking)") . Set PR=$$ASK^vhINP(Titel,25,PR,"Korttekst, Identnummer of #Dossier "_$$TIT2(LimT,LimV),Tekst_" voor lijst"_$S(LimO="":", L=leverancier, K=klassificatie, C=Klant, Z=zonder",1:$S($L(ExtKom):", "_ExtKom,1:""))_$S(EntExit:", []=Geen",1:""),,AfterPrompt,,"UE") Set DefInp="" If PR="+" Set PlusKey=MemPoolKLNr,PoolKLNr=$S(PoolKLNr:"",1:MemPoolKLNr) Goto SEL2 If PR="*",Opties["NOKP" Set Opties=$P(Opties,"NOKP")_$P(Opties,"NOKP",2) Set (PoolKLNr,MemPoolKLNr,PlusKey)="" Goto SEL2 If PR="-"!(PR=".") Set PRNr=PR Goto EXIT If PR="",'zb,EntExit Set PRNr=PR Goto EXIT If PR=""!zb Kill %SelProd Do LIST(LimT,LimV):$L(LimT),LISTKT("","",""):'$L(LimT) Goto SEL2:'PRNr,EXIT If PR?1P4.7N,$D(^KPR($E(PR,2,8))),$$CHECK($E(PR,2,8)) Kill %SelProd Set PRNr=$E(PR,2,8) Goto EXIT ; Intern product nummer If PR?1"#"1.5E Kill %SelProd Do LISTHD(LimT,LimV,PR) Goto SEL2:'PRNr,EXIT:PRNr Set PRNr="" Goto SEL2 ; Halux dossiernummer Kill:$L(PR)<$L($G(%SelProd("Korttekst"))) %SelProd Set (IIPR,%SelProd("Via"))=PR Do PrepPatM Set IPR=PR Set NotFound=0 Kill Y If '$L(LimO),PR="K" Set PlusKey=MemPoolKLNr,Key=$P($$SELECT^KLASS(-3),D,1) Set:Key LimT="KL",LimV=Key Goto SEL2 If '$L(LimO),PR="L" Set PlusKey=MemPoolKLNr,Key=$$SELECT^LEVER(1,"","Product van leverancier : ") Set:Key LimT="L",LimV=Key Goto SEL2 If '$L(LimO),PR="C" Set PlusKey=MemPoolKLNr,Key=$$SELECT^KLANT6(1,"","Product afgenomen door klant : ") Set:Key LimT="K",LimV=Key Goto SEL2 If '$L(LimO),PR="Z" Set (LimT,LimV)="" Goto SEL2 ; Via korttekst Set %SelProd("Korttekst")=$E(PR,1,20) ;Set PRV=$O(^KPR1($E(PR,1,3)_" ")) Set PRV=$O(^Prod.SearchIndexD("K",$E(PR,1,3)_" ")) If $E($E(PRV,1,3),1,$L(PR))=$E(PR,1,3)!(PR["*")!(PR["?")!NoInput Do Goto EXIT:PRNr!NoInput ;Bestaat volgens korttekst .Do LISTKT(LimT,LimV,PR,,NoInput) ; Niet uniek .Set PR=$TR(PR,D,"") If '$G(Y(0)) Set NotFound=1 ; Via oude korttekst If $E(PRV,1,$L(PR))=PR Do If PRNr Do TXT^vhINP("Via oude korttekst, nieuwe korttekst is "_$P(^KPR(PRNr,0),D,1)) Goto EXIT ;Bestaat volgens oude korttekst .;Do LISTKT(LimT,LimV,PR) ; Niet uniek If '$G(Y(0)) Set NotFound=NotFound+1 ; Via identnr. ; 3 gevallen: ; (1) Er is slechts 1 geldige match => Zetten in PRNr en naar EXIT. ; (2) Er is geen match => Verhoog NotFound en verdergaan (via leeranciersref proberen) ; (3) Er zijn meerdere geldige matches => Laat de gebruiker kiezen uit een lijst. Dit werkt momenteel niet correct: als de 1e match volledig is, wordt niet gezocht of er nog matches zijn. Set PRI=$TR(PR,".","") Set PRV=PRI_" " If $D(^Prod.SearchIndexD("I",PRV)) Set tempPRNr=$O(^Prod.SearchIndexD("I",PRV,"")) If $$CHECK(tempPRNr) Set PRNr=tempPRNr Goto EXIT Set PRV=$O(^Prod.SearchIndexD("I",PRV)) If $E(PRV,1,$L(PRI))=PRI Do Goto:PRNr EXIT ;Bestaat volgens identnummer .If $E($O(^Prod.SearchIndexD("I",PRV)),1,$L(PRI))'=PRI Set tempPRNr=$O(^Prod.SearchIndexD("I",PRV,"")) Set:$$CHECK(tempPRNr) PRNr=tempPRNr Quit .Else Do LISTID(LimT,LimV,PRI) ; Niet uniek If '$G(Y(0)) Set NotFound=NotFound+1 ; Via leveranciersref If LimT'="L" Set NotFound=NotFound+1 Goto SEL3 Set PR=$$UPTRIMAN^vhRtn1(IIPR),PRV=PR_" " Set:'$D(^Prod.SearchIndexD("LR",PRV)) PRV=$O(^Prod.SearchIndexD("LR",PRV)) If $E(PRV,1,$L(PR))=PR Do Goto:PRNr EXIT ;Bestaat volgens LEVREF .If $E($O(^Prod.SearchIndexD("LR",PRV)),1,$L(PRI))'=PRI Set:$$CHECK($O(^Prod.SearchIndexD("LR",PRV,""))) PRNr=$O(^Prod.SearchIndexD("LR",PRV,"")) Quit .Else Do LIST(LimT,LimV,PR) ; Niet uniek If '$G(Y(0)) Set NotFound=NotFound+1 SEL3 Goto SEL2:NotFound'=4 Set FP=2301 Write @F,@F1,"Geen product gevonden" If MemPoolKLNr,PoolKLNr=MemPoolKLNr Do .Write " binnen de beperkte lijst" .Write:LimT="L" " van leverancier : "_$E($P(^KLE(^KL1(LimV),0),D,2),1,15) .Write:LimT="K" " gekocht door klant : "_$E($P(^KKL(^KK1(LimV),0),D,2),1,12) .Write:LimT="KL" " van klassificatie : "_$E($$DISPL^KLASS(LimV),1,12) .Write !,"waarvan de korttekst of identnummer begint met "_IPR,@FCH Else Do .Write:LimT="L" " van leverancier : "_$P(^KLE(^KL1(LimV),0),D,2) .Write:LimT="K" " gekocht door klant : "_$P(^KKL(^KK1(LimV),0),D,2) .Write:LimT="KL" " van klassificatie : "_$$DISPL^KLASS(LimV) .Write !,"waarvan de korttekst of identnummer begint met "_IPR,@FCH R *K:10 Write @FCS Set (PoolKLNr,PlusKey)="" ; Niks gevonden voor KS, '+' niet toegelaten Goto SEL2 EXIT If '$L(LimO) Set sRef("SELPR")=LimT_D_LimV Quit PRNr IsKSKlant(KLNr) New KlantID #dim KlantID As DOM.VKP.VanHoeckeKlantID = ##class(DOM.DomeinContext).Instance().GeefLegacyPartijAPI().GeefKlantPartijID(KLNr) Quit '(##class(DOM.DomeinContext).Instance().GeefKlantTypeAPI().IsIndustriePoolKlant(KlantID)) LISTHD(LimT,LimV,PR) ; Tonen van de lijst volgens dossiernummer New R,LD,ZoekString Kill Y,X Do InitCriteria Set ZoekString = $E(##class(TECH.StringUtils).Trim(PR),2,6) I $D(^Prod.SearchIndexD("D",ZoekString_" ")) Do . Set PRNr="" . For Set PRNr=$O(^Prod.SearchIndexD("D",ZoekString_" ",PRNr)) Quit:PRNr="" Do . . Quit:'$$CHECK(PRNr) . . Set NR=$O(Y(""))+1 . . Set Y(NR)=PRNr Else Do . Do InitCriteria . Set pxCriteria.At=$$$ProdCritAtDossier . Set pxCriteria.SearchTxt=ZoekString . Set pxCriteria.MaxCount=500 . Set pxCriteria.Sorted=$$$ProdCritSortedNot . Do blSearch.SearchIndex(pxCriteria,.Y) Set Y(0)=$O(Y(""),-1) Quit:Y(0)="" If Y(0)=1 Set PRNr=Y(1) Quit Set X=$G(%SelProd("X"),1) Do InitList("SELECTHD",.LD,.ShowLT) Kill LD("CM") For Set X=$$SCROLL^vhLIST(.LD) Do Quit:X Quit:X="P" Quit:X="-" Quit:X="." If X="+",PlusKey Quit . If "\ENTER\ \"[(D_X_D) Set X=LD("SELECT") . If X="Z",$G(Y(LD("SELECT"))) Do DISPLAY^HADWIZ(Y(LD("SELECT"))) . If X,'$D(Y(X)) Set X="" If X="+" Set PoolKLNr=$S(PoolKLNr:"",1:MemPoolKLNr) Do LISTHD(.LimT,.LimV,PR,.IndNr,.NoInput) If X Set PRNr=Y(X),%SelProd("PRNr")=PRNr Else Kill %SelProd("PRNr"),%SelProd("X") Quit LISTID(LimT,LimV,PR) ; Tonen van de lijst volgens identnummer New R,LD Kill Y,X Do InitCriteria Set pxCriteria.At=$$$ProdCritAtIdentNr Set pxCriteria.SearchTxt=PR Set pxCriteria.MaxCount=500 Set pxCriteria.Sorted=$$$ProdCritSortedNot Do blSearch.SearchIndex(pxCriteria,.Y) Set Y(0)=$O(Y(""),-1) Quit:Y(0)="" Set X=$G(%SelProd("X"),1) Do InitList("SELECTID",.LD,.ShowLT) Kill LD("CM") For Set X=$$SCROLL^vhLIST(.LD) Do Quit:X Quit:X="P" Quit:X="-" Quit:X="." If X="+",PlusKey Quit . If "\ENTER\ \"[(D_X_D) Set X=LD("SELECT") . If X="Z",$G(Y(LD("SELECT"))) Do DISPLAY^HADWIZ(Y(LD("SELECT"))) . If X,'$D(Y(X)) Set X="" If X="+" Set PoolKLNr=$S(PoolKLNr:"",1:MemPoolKLNr) Do LISTID(.LimT,.LimV,PR) If X Set PRNr=Y(X),%SelProd("PRNr")=PRNr Else Kill %SelProd("PRNr"),%SelProd("X") Quit LISTKT(LimT,LimV,PR,IndNr,NoInput) ; Tonen van de lijst volgens korttekst New R,LD Kill Y,X Do InitCriteria Set pxCriteria.At=$$$ProdCritAtKortTekst Set pxCriteria.SearchTxt=PR Set pxCriteria.MaxCount=500 Set pxCriteria.Sorted=$$$ProdCritSortedKortTekst Do blSearch.SearchIndex(pxCriteria,.Y) Set Y(0)=$O(Y(""),-1) Quit:Y(0)="" Set NoInput=$G(NoInput) Set X=1 If 'NoInput,Y(0)>1 Do . Set X=$G(%SelProd("X"),1) . Do InitList("SELECTKT",.LD,.ShowLT) . Kill LD("CM") . For Set X=$$SCROLL^vhLIST(.LD) Do Quit:X Quit:X="P" Quit:X="-" Quit:X="." If X="+",PlusKey Quit . . If "\ENTER\ \"[(D_X_D) Set X=LD("SELECT") . . If X="Z",$G(Y(LD("SELECT"))) Do DISPLAY^HADWIZ(Y(LD("SELECT"))) . . If X,'$D(Y(X)) Set X="" . If X="+" Set PoolKLNr=$S(PoolKLNr:"",1:MemPoolKLNr) Do LISTKT(.LimT,.LimV,PR,.IndNr,.NoInput) If '$D(X) Do Quit . Set FP=21-(ShowLT*2)*100+1 . Write @F,@F1 If NoInput,X'=Y(0) Else If X Set PRNr=Y(X),%SelProd("PRNr")=PRNr Else Kill %SelProd("PRNr"),%SelProd("X") Quit LIST(LimT,LimV,PR) ; Tonen van de volledige lijst New R,LD Kill Y,X,LevRef,KLNr,KGS,KHS,KSS Do InitCriteria Set pxCriteria.At=$S(LimT="L":"LR",1:"K") Set pxCriteria.Sorted=$S(LimT="L":"LR",1:"SK") Set pxCriteria.SearchTxt=$G(PR) Set:LimT="K" pxCriteria.LimitCustomer=LimV Do blSearch.SearchIndex(pxCriteria,.Y) Set Y(0)=$O(Y(""),-1) Quit:Y(0)="" Set X=$G(%SelProd("X"),1) Do InitList($S(LimT="L":"SELECTLE",1:"SELECTKT"),.LD,.ShowLT) Kill LD("CM") For Set X=$$SCROLL^vhLIST(.LD) Do Quit:X Quit:X="P" Quit:X="-" Quit:X="." If X="+",PlusKey Quit . If "\ENTER\ \"[(D_X_D) Set X=LD("SELECT") . If X="Z",$G(Y(LD("SELECT"))) Do DISPLAY^HADWIZ(Y(LD("SELECT"))) . If X,'$D(Y(X)) Set X="" If X="+" Set PoolKLNr=$S(PoolKLNr:"",1:MemPoolKLNr) Do LIST(.LimT,.LimV,.PR) If X Set PRNr=Y(X),%SelProd("PRNr")=PRNr Else Kill %SelProd("PRNr"),%SelProd("X") Quit ; De lijstdefinitie opzetten InitList(LDRef,LD,ShowLT) Do INIT^vhLIST("PRODUKT",LDRef,.LD) Set LD("POS","NORMAL")=LD("POS"),LD("SET","NORMAL")=LD("SET") Set R=$P(LD("POS"),"`"),$P(R,";")=$P(R,";")-2,$P(R,";",3)=$P(R,";",3)-2,$P(LD("POS","EXTRA"),"`")=R Set LD("SET","EXTRA")=LD("SET"),$P(LD("SET","EXTRA"),"`")=R Set R=$P(LD("POS"),"`",2),$P(R,";")=$P(R,";")-2,$P(R,";",3)=$P(R,";",3)-2,$P(LD("POS","EXTRA"),"`",2)=R Set ShowLT='$G(ShowLT) Do SwitchList(.LD,.ShowLT) Quit ; De lijstdefinitie wisselen tussen normaal en extra SwitchList(LD,ShowLT) Set ShowLT='$G(ShowLT) Set LD("POS")=LD("POS",$S(ShowLT:"EXTRA",1:"NORMAL")) Set LD("SET")=LD("SET",$S(ShowLT:"EXTRA",1:"NORMAL")) Set FP=21-('ShowLT*2)*100+1 Write @F,@F1 Do WRITE^vhLIST(.LD) Do:ShowLT ShowLT($G(Y($G(LD("SELECT"),1)))) Quit ShowLT(Rec) New PRNr,LangTxt,Omschr Set PRNr=$P(Rec,D),Omschr=##class(Prod.ProductTekst).GetOmschrijvingViaPRNr(PRNr,,D,1),LangTxt="" For Quit:$P(Omschr,D)="" Quit:$L(LangTxt_", "_$P(Omschr,D))>82 Set LangTxt=LangTxt_", "_$P(Omschr,D),$P(Omschr,D,1,2)=$P(Omschr,D,2) Set $E(LangTxt,1,2)="",FP=2301 Write @F,@FMTI,LangTxt,$J("",80-$L(LangTxt)),@FMTi Set LangTxt="" For Quit:$P(Omschr,D)="" Quit:$L(LangTxt_", "_$P(Omschr,D))>82 Set LangTxt=LangTxt_", "_$P(Omschr,D),$P(Omschr,D,1,2)=$P(Omschr,D,2) Set $E(LangTxt,1,2)="",FP=2401 Write @F,@FMTI,LangTxt,$J("",80-$L(LangTxt)),@FMTi Quit TIT(LimT,LimV,Type) ; Titel afhankelijk van LimT New Tit,Tit2 Set Type=$G(Type) Set Tit="Selecteer via " If LimT="L" Set Tit=Tit_"leverancier : "_$P(^KLE(^KL1(LimV),0),D,2) Else If LimT="K" Set Tit=Tit_"klant : "_$P(^KKL(^KK1(LimV),0),D,2) Else If LimT="KL" Set Tit=Tit_"klassificatie : "_$$DISPL^KLASS(LimV) Else Set Tit=Tit_$S(Type="#":"dossiernummer "_$E(PR,2,5)_" ",Type="I":"identnummer ",Type="L":"levref ",1:"korttekst ") Set:MemPoolKLNr Tit2=$S(PoolKLNr:"Beperkt tot "_$S(IsKSCust:"KS",1:"IP")_" (druk + voor alles)",1:" Geen "_$S(IsKSCust:"KS",1:"IP")_" beperking (druk + voor beperking)"),$E(Tit,81-$L(Tit2),999)=Tit2 Set Tit=$E(Tit,1,80) Quit Tit TIT2(LimT,LimV) ; Titel afhankelijk van LimT New Tit Quit:'$L(LimT) "" Set Tit="beperkt tot " Set:LimT="L" Tit=Tit_"leverancier : "_$P(^KLE(^KL1(LimV),0),D,2) Set:LimT="K" Tit=Tit_"klant : "_$P(^KKL(^KK1(LimV),0),D,2) Set:LimT="KL" Tit=Tit_"klassificatie : "_$$DISPL^KLASS(LimV) Set Tit=$E(Tit,1,50) Quit Tit ; Voorbereiding voor patternmatch KORTTEKST PrepPatM Set PR=$TR(PR," ","*") Set KeepCharOrig="@/.#+-",KeepChar="" For I=1:1:$L(KeepCharOrig) Set:PR[$E(KeepCharOrig,I) KeepChar=KeepChar_$E(KeepCharOrig,I) Set PR=$ZSTRIP($ZCVT(PR,"U"),"*P",,KeepChar_"*?\") Set PatternKey=$$WildCardToPattern^vhLib(PR,1) Set KeepChar=KeepChar_$S(PR["\*":"*",1:"")_$S(PR["\?":"?",1:"") ; KeepChar uitbreiden met * of ? indien \* of \? voorkomt Quit ;Nakijken of het product voldoet aan limiet CHECK(PRNr) Do InitCriteria Set IdentNr=$P(^KPR(PRNr,2),D,25) Set pxCriteria.At="I" Set CompresKey=$$UPTRIMAN^vhRtn1(IdentNr)_" " Set IndexContent=^Prod.SearchIndexD(pxCriteria.At,CompresKey,PRNr) Do blSearch.SetDefault(pxCriteria) If 'blSearch.CheckCriteria(PRNr,pxCriteria,IndexContent) Quit 0 ; Deze is met Try-Catch geïmplementeerd. Quit 1 ; initialize pxCriteria InitCriteria N count,ClassDef ; all properties are set to blank ; If '$Data(blSearch) Set blSearch=##class(BL.Prod.Search).%New() Set Usage=$S(Opties["ALL":$$$ProdCritUsageAll,'PoolKLNr:$$$ProdCritUsageOVALL,IsKSCust:$$$ProdCritUsageOVKS,1:$$$ProdCritUsageOVIP) Set pxCriteria=##class(BL.Prod.sub.pxSearchCriteria).%New(Usage) Set:PoolKLNr pxCriteria.VerifyCustomer=PoolKLNr ;translate of the options in pxCriteria If Opties'["NODO" Set pxCriteria.StockType=$LB($$$ProdCritStock,$$$ProdCritStockNot,$$$ProdCritStockContract,$$$ProdCritStockDirectOrder) ; Stock, NietStock, Contract, DirectOrder If Opties["NOKP" Set pxCriteria.Saleable=$LB($$$ProdCritSaleable) ; alleen verkoopbare producten If LimT="L" Set pxCriteria.LimitSupplier=LimV If LimT="KL" Do . Set Lijst="" . Set xKlas=^KLAS("K",LimV) . If $Piece(xKlas,D)=1 Do . . Set code="" . . For Set code=$o(^KLAS("K",code)) quit:code="" Do . . . If $Piece(^KLAS("K",code),D,8)=LimV Set Lijst=Lijst_$LB(code) . Else If $Piece(xKlas,D)=2 Do . . Set code="" . . For Set code=$o(^KLAS("K",code)) quit:code="" Do . . . If $Piece(^KLAS("K",code),D,9)=LimV Set Lijst=Lijst_$LB(code) . Else Set Lijst=$LB(LimV) . Set pxCriteria.lbLimitKlasKeys=Lijst If LimT="K" Set pxCriteria.LimitCustomer=LimV Set pxCriteria.MaxCount=500 ;do WOIP^vhDBG(15,pxCriteria) Quit