PAKKETS ;Pakket : Select [ 12/22/2003  4:16 PM ]
 
 ; Selekteer een pakket voor een bepaalde klant
SELECT(KLNr,PRNr,Beperk,Aktief) 
 New %J,K,R,X,Ref,PAKNr,DL,PAKKET,Tekst,Tekst2
 Set %J=$$%J^vhRtn1()
 Set KLNr=$G(KLNr),PRNr=$G(PRNr)
 Set Aktief=$G(Aktief)
 Set Beperk=$G(Beperk) ; Beperk opzoek tot de opgegeven KLNr, geen nv eigen pakketen
 Set Tekst=$S($P(^cLOG(boot,"DEV",$$IO^cQ5),"\")="MC":"PageUp",1:"SEL")_" voor lijst"
 Do INIT^PROC($S($L(KLNr):"SELPAKKET",1:"SELPAKKETA"),"PAKKET")
SASK If PRNr Do FETCHPKT(KLNr,PRNr) Set R=""
 If 'PRNr Do  If zb=-1 Goto SASK
 .Set R=$$UPCASE^vhRtn1($$ASK^vhINP("Pakket : ",25,"",Tekst,$G(Tekst2),"","",$S($L($G(Tekst2)):10,1:"")))
 .Set Tekst2=""
 If R="-" Kill ^HULP(%J) Quit "-"
 If $G(zb)!(R="") Do FETCHPKT(KLNr,PRNr) Set R=$$LIST() Goto SASK:R="-" Kill ^HULP(%J) Quit R
 Do FETCHPKT(KLNr,PRNr,R) Set R=$$LIST(R) Goto SASK:R="-"
 Kill ^HULP(%J)
 Quit R
 
 ; Ophalen paketten voor een bepaalde klant
FETCHPKT(KLNr,PRNr,Ref) 
 New RefTemp,PAKNr
 Kill ^HULP(%J)
 If KLNr="",PRNr Do  Quit
 .For  Set KLNr=$O(^PAKKET("IP",PRNr,KLNr)) Quit:KLNr=""  Do
 ..Set PAKNr=""
 ..For  Set PAKNr=$O(^PAKKET("IP",PRNr,KLNr,PAKNr)) Quit:PAKNr=""  Do
 ...Set Ref=$$UPTRIMAN^vhRtn1($P(^PAKKET("D",PAKNr),D,2))
 ...If Aktief Quit:$P(^PAKKET("D",PAKNr),D,5)
 ...Set ^HULP(%J,Ref_" "_PAKNr)=PAKNr
 If KLNr="" Do  Quit
 .Set RefTemp=$$UPTRIMAN^vhRtn1($G(Ref))
 .For  Set KLNr=$O(^PAKKET("IK",KLNr)) Quit:KLNr=""  Do
 ..Set Ref=RefTemp
 ..If $L(Ref),$D(^PAKKET("IK",KLNr,Ref)) Set Ref=$O(^PAKKET("IK",KLNr,Ref),-1)
 ..For  Set Ref=$O(^PAKKET("IK",KLNr,Ref)) Quit:Ref=""!($E(Ref,1,$L(RefTemp))'=RefTemp)  Do
 ...Set PAKNr=^PAKKET("IK",KLNr,Ref)
 ...If Aktief Quit:$P(^PAKKET("D",PAKNr),D,5)
 ...Set ^HULP(%J,Ref_" "_PAKNr)=PAKNr
 If PRNr Do  Quit
 .Set PAKNr=""
 .For  Set PAKNr=$O(^PAKKET("IP",PRNr,KLNr,PAKNr)) Quit:PAKNr=""  Do
 ..Set Ref=$$UPTRIMAN^vhRtn1($P(^PAKKET("D",PAKNr),D,2))
 ..If Aktief Quit:$P(^PAKKET("D",PAKNr),D,5)
 ..Set ^HULP(%J,Ref_" "_PAKNr)=PAKNr
 Set RefTemp=$$UPTRIMAN^vhRtn1($G(Ref))
 Do  If 'Beperk,KLNr Set KLNr=0 Do
 .Set Ref=RefTemp
 .If $L(Ref),$D(^PAKKET("IK",KLNr,Ref)) Set Ref=$O(^PAKKET("IK",KLNr,Ref),-1)
 .For  Set Ref=$O(^PAKKET("IK",KLNr,Ref)) Quit:Ref=""!($E(Ref,1,$L(RefTemp))'=RefTemp)  Do
 ..Set PAKNr=^PAKKET("IK",KLNr,Ref)
 ..If Aktief Quit:$P(^PAKKET("D",PAKNr),D,5)
 ..Set ^HULP(%J,Ref_" "_PAKNr)=PAKNr
 Quit
 
 ; Lijst alle pakketten volgens de input van select
LIST(R) 
 Set R=$G(R)
 If '$D(^HULP(%J)) Do  Quit "-"
 .If $L(R) Set Tekst2="Geen pakket gevonden waarvan de pakketnaam begint met "_R
 .Else  If 'PRNr Set Tekst2="Geen pakket gevonden"
 .Else  Set Tekst2="Geen pakket gevonden waartoe het geselekteerde produkt behoort"
 .Set PRNr=0
 Set PRNr=0
 Set (PAKKET(6),PAKKET(7))=1 Kill PAKKET(9)
 Do RL^PROC1
 Do WL^PROC
LSL Do SL^PROC
 If R="-" Quit R
 If R="ENTER",$D(^HULP(%J,PAKKET(6))) Quit ^HULP(%J,PAKKET(6))
 Goto LSL
 
SELIMP(Local,KLNr,PRNr,Beperk) 
 New PAKNr,Faktor
 Set PAKNr=$$SELECT($G(KLNr,0),$G(PRNr),$G(Beperk),1)
 Goto IMPORT2
IMPORT(Local,PAKNr,Faktor) 
 New KLNr,PRNr
IMPORT2 New Y,X,Optie,Sel,Rec,Key,I,Default,Txt
 Kill Y,X
 Quit:'PAKNr
 Quit:'$D(^PAKKET("D",PAKNr))
 Set:'$G(Faktor) Faktor=$$ASK^vhINP("Vermenigvuldingsfaktor : ",3,1,"","",""," voor "_$P(^PAKKET("D",PAKNr),D,2))
 Quit:'Faktor
 Set Rec=^PAKKET("D",PAKNr)
 Set Local=PAKNr_D_$P(Rec,D,2)_D_Faktor_D_$P(Rec,D,3)
 Set:$L($P(Rec,D,4)) $P(Local,D,2)=$P(Rec,D,4)
 Do ADDPAK(PAKNr)
 If $D(Y) Do  ; Tonen van de optie lijst
 .Set Key="",Y=0,X="",Optie=""
 .For  Set Key=$O(Y(Key)) Quit:Key=""  Do
 ..Set Rec=Y(Key)
 ..If $L(Optie),$P(Rec,D,4)'=Optie Set Y=Y+1,Y(Y)=$J("",25)
 ..Set Optie=$P(Rec,D,4)
 ..Set Y=Y+1
 ..Set Y(Y)=Rec
 ..Kill Y(Key)
 ..If $L($P(Rec,D,5)),'$D(Sel($P(Rec,D,4))) Set X=X_";"_Y,Sel(Optie)=Y
 .Set Y(0)=Y,Y="10\M\Optionele produkten voor pakket "_$P(^PAKKET("D",PAKNr),D,2)_", Spatie=(De)Select, []=Exit"_D_"CBPOP^PAKKETS"
 .Do ^POP
 .If X="-" Kill Local Quit  ; Annuleer
 .If $L(X) For I=1:1:$L(X,";") Do 
 ..Set Rec=Y($P(X,";",I))
 ..Set Local($P(Rec,D,3))="P"_D_$P(Rec,D,2)_D_$P(Rec,D,6)
 Set Key="",Y=0
 For  Set Key=$O(Local(Key)) Quit:Key=""  Do
 .Set Y=Y+1
 .Set Local(Y)=Local(Key)
 .Kill Local(Key)
 Set $P(Local,D,5)=Y
 Quit  ; Return value zit in .Local
 
ADDPAK(PAKNr) ; Recursief opgeroepen voor links
 New LPAKNr,PRNr,Optie,Rec,Key,Txt,Default
 Set PRNr=""
 For  Set PRNr=$O(^PAKKET("D",PAKNr,PRNr)) Quit:PRNr=""  Do:PRNr'="L"
 .Set Rec=^(PRNr)
 .Set Optie=$P(Rec,D,2)
 .Set Key=$$SORTKEY^PRODUKT(PRNr)
 .If Optie'?1U.1"*" Do
 ..Set Local(Key)="P"_D_PRNr_D_(Faktor*$P(Rec,D))
 .Else  Do  ; Optioneel
 ..Set Default=""
 ..Set:Optie?1U1"*" Default=1,Optie=$E(Optie)
 ..Set Txt=$P(^KPR(PRNr,0),D,1)_" | "_$P(^(0),D,2)
 ..Set:$L($P(^(0),D,11)) Txt=Txt_$S($E(Txt,$L(Txt))=",":" ",1:", ")_$P(^(0),D,11)
 ..Set Y(Optie_Key)=$E(Txt,1,75)_D_PRNr_D_Key_D_Optie_D_Default_D_(Faktor*$P(Rec,D))
 Set LPAKNr=""
 For  Set LPAKNr=$O(^PAKKET("D",PAKNr,"L",LPAKNr)) Quit:LPAKNr=""  Do
 .Do ADDPAK(LPAKNr) ; Recursie
 Quit
 
CBPOP ; Callback vanuit ^POP     
 If '$P(Y(CUR),D,2) Set X="" Quit  ; Scheidingslijn
 Set Optie=$P(Y(CUR),D,4)
 If $G(Sel(Optie))=CUR Kill Sel(Optie) Quit  ;Tweede maal = Disable
 Quit:'$L(X)  ; Geen meer geselekteerd
 If $D(Sel(Optie)) Do DISABLE^POP(Sel(Optie))
 Set Sel(Optie)=CUR
 Quit