#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)
 ;ExtKom : Extra kommentaar (enkel voor beperkte lijst)
 ;EntExit : Geen lijst bij leeg inputveld en ENTER maar geef leeg terug
 ;NoInput : geen selectie op scherm
 ;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
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,blProdSelect,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=$$ISKLANT^KS(PoolKLNr,1)
 Set blSearch=##class(BL.Prod.Search).%New()
 Set blProdSelect=##class(BL.Prod.Select).Instantiate() ; wordt gebruikt door CHECK
 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.4U Kill %SelProd Do LISTHD(LimT,LimV,PR) Goto SEL2:'PRNr,EXIT Set PRNr="" Goto SEL2 ; Halux dossiernummer
 Kill:$L(PR)<$L($G(%SelProd("Korttekst"))) %SelProd
 Set (IIPR,%SelProd("Via"))=PR
 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)_" "))
 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
 Set PRI=$TR(PR,".","")
 Set PRV=PRI_" "
 I $D(^Prod.SearchIndexD("I",PRV)) Set tempPRNr=$O(^Prod.SearchIndexD("I",PRV,"")) I $$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=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
 
LISTHD(LimT,LimV,PR) ; Tonen van de lijst volgens dossiernummer
 New R,LD
 Kill Y,X
 I $D(^Prod.SearchIndexD("D",$E(PR,2,5)_" ")) Do
 . Set PRNr=""
 . For  Set PRNr=$O(^Prod.SearchIndexD("D",$E(PR,2,5)_" ",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=$E(PR,2,5)
 . Set pxCriteria.MaxCount=500
 . Set pxCriteria.Sorted=$$$ProdCritSortedSortKey
 . 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=$$$ProdCritSortedSortKey
 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=$$$ProdCritSortedSortKey
 Do blSearch.SearchIndex(pxCriteria,.Y)
 Set Aantal=$O(Y(""),-1)
 Quit:Aantal=""
 Set Y(0)=$S(Aantal>4:4,1:Aantal)
 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="M" Do SwitchList(.LD,.ShowLT)
 . 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="K"
 Set pxCriteria.SearchTxt=$G(PR)
 Do blSearch.SearchIndex(pxCriteria,.Y,500)
 Set Aantal=$O(Y(""),-1)
 Quit:Aantal=""
 Set Y(0)=$S(Aantal>4:4,1:Aantal)
 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="M" Do SwitchList(.LD,.ShowLT)
 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
 
 ;Nakijken of het product voldoet aan limiet
CHECK(PRNr)
 Do InitCriteria
 Set IdentNr=$P(^KPR(PRNr,2),D,25)
 Set At="I"
 Set CompresKey=$Tr(IdentNr,".","")_" "
 Set IndexContent=^Prod.SearchIndexD(At,CompresKey,PRNr)
 If 'blSearch.QuickCheckCriteria(PRNr,pxCriteria,IndexContent) Quit 0
 If 'blSearch.FullCheckCriteria(PRNr,pxCriteria) Quit 0
 Quit 1
 
InitCriteria  ; initiallize pxCriteria
 N count
 if $Data(pxCriteria) Do
 . Set ClassDef = ##class(%Dictionary.ClassDefinition).%OpenId("BL.Prod.sub.pxSearchCriteria")
 . Set count =ClassDef.Properties.Count()
 . For i=1:1:count Do
 . . Set $ZobjProperty(pxCriteria,ClassDef.Properties.GetAt(i).Name)=""
 Else  Set pxCriteria=##class(BL.Prod.sub.pxSearchCriteria).%New()
 Set pxCriteria.Usage="ALL"
 If Opties["NODO" Set pxCriteria.StockType=$LB("S","N","C")
 If Opties["NOKP" Set pxCriteria.Saleable=$LB("S","H")
 If PoolKLNr Do
 . Set px.Pool=$S(IsKSCust:"KS",1:"IP")
 . Set px.LimitCustomer=PoolKLNr
 If LimT="L" Set pxCriteria.LimitSupplier=LimV
 If LimT="KL" Set pxCriteria.Classification=LimV
 If LimT="K" Set pxCriteria.LimitCustomer=LimV
 Quit