PVPAK ;Pakket : Wijzigen [ 10/30/2001  4:46 PM ]
 I '$D(Q) S Q="K" D ^cA604
 New KLNr
 For  Do  Quit:KLNr="-"
 .Set FP=101 Write @F,@F1,@FMTI," Beheer Pakketten - ",QN," ",@FMTi
 .Set KLNr=$$ASK^vhINP("Klant specifieke of eigen pakketten : ",1,"","K[] = Klantspecifieke, [] = N.V. eigen pakketten, -[] = Exit")
 .Quit:KLNr="-"
 .If KLNr'="K",KLNr'="k" Set KLNr=0
 .Else  Set KLNr=$$SELECT^KLANT6(1) Quit:'KLNr
 .Do EDIT(KLNr)
 Quit
 
 ; Selekteer een pakket voor een bepaalde klant
SELECT(KLNr,PRNr,Beperk) 
 New %J,K,R,X,Ref,PAKNr,DL,PAKKET,Tekst,Tekst2
 Set %J=$$%J^vhRtn1()
 Set KLNr=$G(KLNr),PRNr=$G(PRNr)
 Set Beperk=$G(Beperk) ; Beperk opzoek tot de opgegeven KLNr, geen N.V. eigen pakketen
 Set Tekst=$S($P(^cLOG(boot,"DEV",$I),"\")="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))
 ...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),^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))
 ..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),^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))
 Goto IMPORT2
IMPORT(Local,PAKNr,Faktor) 
 New KLNr,PRNr
IMPORT2 New Y,X,Optie,Sel,Rec,Key,I,Default
 Kill Y,X
 Quit:'PAKNr
 Quit:'$D(^PAKKET("D",PAKNr))
 Set:'$G(Faktor) Faktor=$$ASK^vhINP("Vermenigvuldingsfaktor : ",3,1)
 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)
 Set PRNr=""
 For  Set PRNr=$O(^PAKKET("D",PAKNr,PRNr)) Quit:PRNr=""  Do
 .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 Y(Optie_Key)=$P(^KPR(PRNr,0),D,1)_D_PRNr_D_Key_D_Optie_D_Default_D_(Faktor*$P(Rec,D))
 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)_D_"CBPOP^PAKKET"
 .Do ^POP
 .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
 
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
 
 ; **** WIJZIGEN PAKKETTEN ****
 
EDIT(KLNr) 
 New Input,R,%J,Y,X,PRNr,IsChanged
 Do INIT Quit:'%TC
 Write @F11,@F1
 Do COMMAND,SAVE:IsChanged,CLEAN
 Quit
 
COMMAND ; Lus voor het uitvoeren van de opdrachten
 Set Input=""
 For  Quit:Input="-"!(Input=".")  Do
 .Do REFRESH,SL^PROC
 .Set Lijn=PAKKET(6) Set:'$D(^HULP(%J,"L",Lijn)) Lijn=0
 .Set Input=R
 .If Input="HELP" Do HELP
 .If Input="N" Do LNIEUW
 .If Input="ENTER",Lijn Do LWIJZIG(Lijn)
 .If Input="O",Lijn Do LOPTIE(Lijn)
 .If Input="A",Lijn Do LAPPEND(Lijn)
 .If Input="V",Lijn Do LDELETE(Lijn)
 .If Input="D",Lijn Do LDUPLI(Lijn)
 .If Input="P",Lijn Do RAADPL(Lijn)
 .If Input="S",Lijn Do SORT         
 .If Input="PRINT",Lijn Do PRINT        
 .If Input="."!(Input="-"),IsChanged Set Input=$$SAVE^vhINP(1) 
 .Do REFRESH
 Set:Input'="-" IsChanged=0
 Quit
 
INIT ; Locks en Opbouw hulpbestand 
 Kill Y
 Set %TC=0
 Set %J=$$%J^vhRtn1()
 Do ADD^vhLock("^PAKKET(""IK"",KLNr)")
 If '%TC Do LDISP^vhLock("^PAKKET(""IK"",KLNr)","Pakketten bestand") Quit
 Set Init=1 Do RESET^vhScherm,ADD^vhScherm(1,1),REFRESH Kill Init
 Kill ^HULP(%J)
 Set PakNm=""
 For  Set PakNm=$O(^PAKKET("IK",KLNr,PakNm)) Quit:PakNm=""  Do
 .Set PAKNr=^(PakNm)
 .Set ^HULP(%J,"D",PAKNr)=^PAKKET("D",PAKNr)
 .Set ^HULP(%J,"IN",PakNm)=PAKNr
 .Set PRNr=""
 .For  Set PRNr=$O(^PAKKET("D",PAKNr,PRNr)) Quit:'PRNr  Do
 ..Quit:'$D(^KPR(PRNr))
 ..Set ^HULP(%J,"D",PAKNr,PRNr)=^PAKKET("D",PAKNr,PRNr)
 ..Set ^HULP(%J,"IP",PRNr,PAKNr)=""
 Set %TC=1
 Set IsChanged=0
 Set Screen=""
 Do INIT^PROC("PAKKET")
 Do RL^PROC1
 Set PAKKET(2,1)=^LD("L","PAKKET2")
 Set PAKKET(3)=$S(KLNr:6,1:4),PAKKET(4)=24-PAKKET(3)+1
 Do ADD^vhScherm(1,24)
 Quit
 
SAVE ; Opslaan van de wijzigingen
 ; Verwijderen van alle pakketten van die klant
 Set Nm=""
 For  Set Nm=$O(^PAKKET("IK",KLNr,Nm)) Quit:Nm=""  Do DELOBJ(^(Nm))
 ; Copieren naar PAKKET, en nakijken Type = D,C of E
 Set PAKNr=""
 For  Set PAKNr=$O(^HULP(%J,"D",PAKNr)) Quit:'PAKNr  Do
 .Set PAKRec=^HULP(%J,"D",PAKNr)
 .Set PRNr="",Cnt=0
 .For  Set PRNr=$O(^HULP(%J,"D",PAKNr,PRNr)) Quit:'PRNr  Do
 ..Set Cnt=Cnt+1
 ..Set ^PAKKET("IP",PRNr,KLNr,PAKNr)=""
 ..Set ^PAKKET("D",PAKNr,PRNr)=^HULP(%J,"D",PAKNr,PRNr)
 .Quit:'Cnt  ; Geen produkten gespecifieerd
 .If Cnt>1 Set $P(PAKRec,D,3)="D" ; Van 1 naar N -> Divergerend
 .If Cnt=1 Do  ; Enkel of convergerend
 ..Set PRNr=$O(^HULP(%J,"D",PAKNr,""))
 ..Set Cnt=-1
 ..Set PNr=""
 ..For  Set PNr=$O(^HULP(%J,"IP",PRNr,PNr)) Quit:'PNr  Set:$O(^HULP(%J,"D",PNr,""))=$O(^HULP(%J,"D",PNr,""),-1) Cnt=Cnt+1
 ..If 'Cnt Set $P(PAKRec,D,3)="E" ; Van 1 naar 1
 ..If Cnt Set $P(PAKRec,D,3)="C" ; Van N naar 1 -> Convergerend
 .Set $P(PAKRec,D,1)=KLNr
 .Set ^PAKKET("D",PAKNr)=PAKRec
 .Set ^PAKKET("IK",KLNr,$$UPTRIMAN^vhRtn1($P(PAKRec,D,2)))=PAKNr
 Quit
 
DELOBJ(PAKNr) 
 New KLNr
 Set PRNr=""
 Set KLNr=$P(^PAKKET("D",PAKNr),D)
 For  Set PRNr=$O(^PAKKET("D",PAKNr,PRNr)) Quit:'PRNr  Kill ^PAKKET("IP",PRNr,KLNr,PAKNr)
 Kill ^PAKKET("IK",KLNr,$$UPTRIMAN^vhRtn1($P(^PAKKET("D",PAKNr),D,2)))
 Kill ^PAKKET("D",PAKNr)
 Quit
 
REFRESH ; Herstellen scherm
 If sRT=1 Write @F11,@FMTI," Beheer pakketten - ",QN," ",@FMTi,@F2 Set R=$S($D(Init):"I'm thinking",KLNr:"Klant specifieke",1:"N.V. eigen") Set FP=180-$L(R)-1 Write @F,@FMTB," ",R," ",@FMTb
 If KLNr Do
 .If sRT<3,sRB>1 Set FP=201 Write @F,@F2
 .If sRT<4,sRB>2 Set FP=301 Write @F," Klant : ",KLNr," ",$P(^KKL(^KK1(KLNr),0),D,2),@F2
 .If sRT<5,sRB>3 Set FP=401 Write @F,@F2
 .If sRB=24,sRT<7 Do SORT
 .If sRB>4 Set DL(2)=sRT,DL(3)=sRB Do WL^PROC Kill DL(2),DL(3)
 Else  Do
 .If sRT<3,sRB>1 Set FP=201 Write @F,@F2
 .If sRB=24,sRT<5 Do SORT
 .If sRB>2 Set DL(2)=sRT,DL(3)=sRB Do WL^PROC Kill DL(2),DL(3)
 Do RESET^vhScherm
 Quit
 
HELP ; Tonen van menu en help
 Set R=""
 Do POP^MN("PAKKET")
 Set Input=R
 If Input'="HELP" Do REFRESH Quit
 New HLP
 Set HLP(1)="PAKKET"
 Set HLP(3)=PAKKET(3)
 Do ^HELP
 Do ADD^vhScherm(PAKKET(3),24)
 Quit
 
CLEAN ; Opkuis en unlock
 Kill ^HULP(%J)
 Lock -^PAKKET("IK",KLNr)
 Quit
 
 ; **** DETAIL ****
CBLIST(Nr,Ref) ; Callback voor het scherm
 If $P(Ref,D,2) Quit 1
 Quit ""
 
CBPRINT(Ref) ; Callback voor het scherm
 If $L(Ref)>1,$P(@Ref,D,2) Quit ";1"
 Quit ""
 
SORT ; Sorteren van de pakketten en de produkten in de pakketten
 Kill ^HULP(%J,"L")
 Set (PRNr,PAKNm)=""
 For  Set PakNm=$O(^HULP(%J,"IN",PakNm)) Quit:PakNm=""  Do
 .Set PAKNr=^(PakNm)
 .Set ^HULP(%J,"L",PakNm_" ")=PAKNr_D
 .For  Set PRNr=$O(^HULP(%J,"D",PAKNr,PRNr)) Quit:'PRNr  Do
 ..Do FETCHPR^UTILI(PRNr)
 ..Set ^HULP(%J,"L",PakNm_" "_$P(B("I"),D,3)_$$COMPR^PRODUKT(PRNr))=PAKNr_D_PRNr
 Do RL^PROC1
 Do ADD^vhScherm(PAKKET(3),24)
 Quit
 
PRINT New PAKKET
 Do INIT^PROC("PAKKET")
 Set PAKKET(2,1)=^LD("L","PAKKET2")
 Set PAKKET(11)="PAKKETTEN"_D_$S(KLNr:"Klant : "_KLNr_" "_$P(^KKL(^KK1(KLNr),0),D,2),1:"N.V. eigen")
 Set PAKKET(10)="CBPRINT^PAKKET"
 Do SORT
 Do PRINT^OUTPUT(.PAKKET,"P","S")
 Quit
 
LNIEUW ;Nieuw pakket
 Lock +^PAKKET("N") Set PAKNr=^PAKKET("N")+1,^PAKKET("N")=PAKNr Lock -^PAKKET("N")
 Do NIEUW^vhScherm("PAKKETHFD")
 Quit:'%SC
 Do NIEUWV^PROC3(PAKNr_D)
 Do REFRESH
 For  Do  Quit:'%SC
 .Do LAPPEND(PAKKET(9))
 Set IsChanged=1
 Quit
 
LDUPLI(Lijn) ;Nieuw pakket
 Set OldPAK=$P(^HULP(%J,"L",Lijn),D)
 Lock +^PAKKET("N") Set PAKNr=^PAKKET("N")+1,^PAKKET("N")=PAKNr Lock -^PAKKET("N")
 Set ^HULP(%J,"D",PAKNr)=^HULP(%J,"D",OldPAK)
 Set $P(^HULP(%J,"D",PAKNr),D,2)=""
 Do EDIT^vhScherm("PAKKETHFD","","","",1) 
 If '%SC Kill ^HULP(%J,"D",PAKNr) Quit
 Set PRNr=""
 For  Set PRNr=$O(^HULP(%J,"D",OldPAK,PRNr)) Quit:'PRNr  Do
 .Set ^HULP(%J,"D",PAKNr,PRNr)=^HULP(%J,"D",OldPAK,PRNr)
 .Set ^HULP(%J,"IP",PRNr,PAKNr)=""
 Set IsChanged=1
 Do ADD^vhScherm(PAKKET(3),24)
 Quit
 
LAPPEND(Lijn) ;Tussen voegen van een produkt
 Set PAKNr=$P(^HULP(%J,"L",Lijn),D)
 Set %SC=0
 Set PRNr=$$SELECT^PRODUKT6("","","","Produkt voor pakket : ")
 Quit:'PRNr
 If $D(^HULP(%J,"IP",PRNr,PAKNr)) Do TXT^vhINP("Produkt bestaat reeds in dit pakket","Het produkt kan niet worden toegevoegd aan dit pakket") Quit
 If $D(^HULP(%J,"IP",PRNr)) Do TXT^vhINP("Produkt bestaat reeds in een ander pakket","Het produkt wordt toegevoegd ook toegevoegd aan dit pakket")
 Set Aantal=$$ASK^vhINP("Aantal stuks van het produkt in het pakket: ",3,1,"","Verplichte ingave")
 Quit:'Aantal
 Set ^HULP(%J,"D",PAKNr,PRNr)=Aantal
 Set ^HULP(%J,"IP",PRNr,PAKNr)=""
 Do APPENDV^PROC3(PAKNr_D_PRNr)
 Set %SC=1
 Set IsChanged=1
 Quit 
 
LWIJZIG(Lijn) 
 Set PAKNr=$P(^HULP(%J,"L",Lijn),D)
 Set PRNr=$P(^HULP(%J,"L",Lijn),D,2)
 Set %SC=0
 If PRNr Do  ; Produkt aantal wijzigen
 .Set Aantal=$$ASK^vhINP("Aantal stuks van het produkt in het pakket: ",3,$P(^HULP(%J,"D",PAKNr,PRNr),D),"","Verplichte ingave")
 .Quit:'Aantal
 .Set $P(^HULP(%J,"D",PAKNr,PRNr),D)=Aantal
 .Set %SC=1
 Else  Do  ; Pakketnaam wijzigen
 .Do EDIT^vhScherm("PAKKETHFD")
 Quit:'%SC
 Do EL^PROC
 Set IsChanged=1
 Quit
 
LOPTIE(Lijn) 
 Set PAKNr=$P(^HULP(%J,"L",Lijn),D)
 Set PRNr=$P(^HULP(%J,"L",Lijn),D,2)
 If PRNr Do  ; Produkt optioneel kode 
 .Set Optie=$$ASK^vhINP("Optiegroep waartoe het produkt behoort: ",3,$P(^HULP(%J,"D",PAKNr,PRNr),D,2),"[]= niet optioneel, A[]=optiegroep A, B[]=optiegroep B, ...","Een optiegroep van een produkt kan een '*' bevatten, dan is dit de default")
 .Set Optie=$$UPCASE^vhRtn1(Optie)
 .Quit:Optie'?1U.1"*"&(Optie'="")
 .Set $P(^HULP(%J,"D",PAKNr,PRNr),D,2)=Optie
 Do EL^PROC
 Set IsChanged=1
 Quit
 
 
LDELETE(Lijn) 
 Set PAKNr=$P(^HULP(%J,"L",Lijn),D)
 Set PRNr=$P(^HULP(%J,"L",Lijn),D,2)
 If PRNr Do
 .If $O(^HULP(%J,"D",PAKNr,""))=$O(^HULP(%J,"D",PAKNr,""),-1) Do TXT^vhINP("Het pakket heeft nu geen produkten meer en het pakket zal bij het verlaten","van dit programma verwijderd worden")
 .Kill ^HULP(%J,"IP",PRNr,PAKNr),^HULP(%J,"D",PAKNr,PRNr)
 .Do DELETE^PROC3
 Else  Do
 .Set R=$$ASK^vhINP("Wenst u het ganse pakket te verwijderen : ",1,"","V[]=Verwijderen")
 .Quit:R'="V"&(R'="v")
 .Set PRNr=""
 .For  Set PRNr=$O(^HULP(%J,"D",PAKNr,PRNr)) Quit:'PRNr  Do
 ..Kill ^HULP(%J,"IP",PRNr,PAKNr)
 .Kill ^HULP(%J,"IN",$$UPTRIMAN^vhRtn1($P(^HULP(%J,"D",PAKNr),D,2)))
 .Kill ^HULP(%J,"D",PAKNr)
 .Do ADD^vhScherm(PAKKET(3),24)
 .Set:PAKKET(6)>1 PAKKET(6)=PAKKET(6)-1
 Set IsChanged=1
 Quit
 
RAADPL(Lijn)  
 Set Rec=$G(^HULP(%J,"L",Lijn))
 Quit:'$P(Rec,D,2)
 Set Screen=$$RAADPL^PRODUKT($P(Rec,D,2),$P(Screen,D,1))
 Do ADD^vhScherm(1,24)
 Quit