PAKKET ;Pakket : Wijzigen [ 07/10/2003  10:52 AM ]
 I '$D(Q) S Q="K" D ^cA604
 New KLNr,Extern
 Set Extern=0
 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, [] = nv eigen pakketten, -[] = Exit")
 .Quit:KLNr="-"
 .If KLNr'="K",KLNr'="k" Set KLNr=0
 .Else  Set KLNr=$$SELECT^KLANT6(1) Quit:'KLNr
 .Do VERWERK(KLNr)
 Quit
 
DISP(KLNr,PRNr,Delim,Length,Type) ; Ophalen van product referenties voor een bep. klant en product
 New D,R,PAKNr,Ref,Str
 Set D="\",Delim=$G(Delim,";"),Length=$G(Length,99),Type=$G(Type),(PAKNr,Str)=""
 For  Set PAKNr=$O(^PAKKET("IP",PRNr,KLNr,PAKNr)) Quit:PAKNr=""  Do
 . Set R=$G(^PAKKET("D",PAKNr))
 . If $L(Type),Type'[$P(R,D,3) Quit  ; Beperking op Type D = divergerend, C = Convergerend, E = een op een
 . Set Ref=$P(R,"\",2)
 . Set:$L(Ref)&&((Delim_Str_Delim)'[(Delim_Ref_Delim)) Str=Str_Delim_Ref ; pakketref mag maar een keer voorkomen voor een product
 Set $E(Str,1,$L(Delim))=""
 For  Quit:$L(Str,Delim)=1  Quit:$L(Str)'>Length  Set Str=$P(Str,Delim,1,$L(Str,Delim)-1)_"..."
 If $L(Str)>Length,$L(Str,Delim)=1,$E(Str,$L(Str)-2,$L(Str))="..." Set $E(Str,$L(Str)-2,$L(Str))=""
 Quit Str
 
 
VERWERK(KLNr) 
 New Input,R,%J,Y,X,PRNr,sS
 Do INIT Quit:'%TC
 Write @F11,@F1
 Do COMMAND,SAVE:sS("MOD"),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 RPLPR(Lijn)
 .If Input="R",Lijn Do RPLKL
 .IF Input="Q" Do COPYKL
 .If Input="S",Lijn Do SORT         
 .If Input="PRINT",Lijn Do PRINT        
 .If Input="I" Do IMPORT
 .If Input="."!(Input="-"),sS("MOD") Set Input=$$SAVE^vhINP(1) 
 .Do REFRESH
 Set:Input'="-" sS("MOD")=0
 Quit
 
INIT ; Locks en Opbouw hulpbestand 
 Kill Y
 Set %TC=0
 Set %J=$$%J^vhRtn1()
 Set:'$D(Extern) Extern=1
 Do ADD^vhLock("^PAKKET(""IK"",KLNr)")
 If '%TC Quit:$G(BackGrnd)  Do LDISP^vhLock("^PAKKET(""IK"",KLNr)","Pakketten bestand") Quit
 Set Init=1 Do RESET^vhScherm,ADD^vhScherm(1,1),REFRESH Kill Init
 Do INIT2(%J,KLNr)
 Set %TC=1
 Set sS("MOD")=0
 Set (ScreenKL,ScreenPR)=""
 Do INIT^PROC("PAKKET")
 Do RL^PROC1
 Set PAKKET(2,"P")=^LD("L","PAKKETP")
 Set PAKKET(2,"L")=^LD("L","PAKKETL")
 Set PAKKET(3)=$S(KLNr:6,1:4),PAKKET(4)=24-PAKKET(3)+1
 Do ADD^vhScherm(1,24)
 Quit
 
INIT2(%J,KLNr) ; Opbouw hulpbestand 
 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 LPAKNr=""
 .For  Set LPAKNr=$O(^PAKKET("D",PAKNr,"L",LPAKNr)) Quit:'LPAKNr  Do
 ..Set ^HULP(%J,"D",PAKNr,"L",LPAKNr)=^PAKKET("D",PAKNr,"L",LPAKNr)
 ..Set ^HULP(%J,"IL",LPAKNr,PAKNr)=""
 Quit
 
SAVE ; Opslaan van de wijzigingen
 Do SAVEDEL(KLNr)
 Do SAVEBLD(%J,KLNr)
 Quit
SAVEDEL(KLNr) ; Verwijderen van alle pakketten van die klant
 Set Nm=""
 For  Set Nm=$O(^PAKKET("IK",KLNr,Nm)) Quit:Nm=""  Do DELOBJ(^(Nm))
 Quit
SAVEBLD(%J,KLNr) ; 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:PRNr'="L"
 ..Set Cnt=Cnt+1
 ..Set ^PAKKET("IP",PRNr,KLNr,PAKNr)=""
 ..Set ^PAKKET("D",PAKNr,PRNr)=^HULP(%J,"D",PAKNr,PRNr)
 .Set LPAKNr=""
 .For  Set LPAKNr=$O(^HULP(%J,"D",PAKNr,"L",LPAKNr)) Quit:LPAKNr=""  Do
 ..Set Cnt=Cnt+1
 ..Set ^PAKKET("IL",LPAKNr,PAKNr)=""
 ..Set ^PAKKET("D",PAKNr,"L",LPAKNr)=^HULP(%J,"D",PAKNr,"L",LPAKNr)
 .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
 
REBUILD ; Herbouwen van alle indexen op ^PAKKET
 New KLNr,PRNr,PAKNr,PAKRec
 Kill ^PAKKET("IP")
 Kill ^PAKKET("IK")
 Kill ^PAKKET("IL")
 Set PAKNr=""
 For  Set PAKNr=$O(^PAKKET("D",PAKNr)) Quit:'PAKNr  Do
 .Set PAKRec=^PAKKET("D",PAKNr)
 .Set KLNr=$P(PAKRec,D,1)
 .Set PRNr=""
 .For  Set PRNr=$O(^PAKKET("D",PAKNr,PRNr)) Quit:PRNr=""  Do:PRNr'="L"
 ..Set ^PAKKET("IP",PRNr,KLNr,PAKNr)=""
 .Set LPAKNr=""
 .For  Set LPAKNr=$O(^PAKKET("D",PAKNr,"L",LPAKNr)) Quit:'LPAKNr  Do
 ..Set ^PAKKET("IL",LPAKNr,PAKNr)=""
 .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:PRNr'="L" ^PAKKET("IP",PRNr,KLNr,PAKNr)
 Set LPAKNr=""
 For  Set LPAKNr=$O(^PAKKET("D",PAKNr,"L",LPAKNr)) Quit:LPAKNr=""  Kill ^PAKKET("IL",LPAKNr,PAKNr)
 Kill ^PAKKET("IK",KLNr,$$UPTRIMAN^vhRtn1($P(^PAKKET("D",PAKNr),D,2)))
 Kill ^PAKKET("D",PAKNr)
 Quit
 
REFRESH ; Herstellen scherm
 Do:'$G(BackGrnd)
 .If sRT=1 Write @F11,@FMTI," Beheer pakketten - ",QN," ",@FMTi,@F2 Set R=$S($D(Init):"I'm thinking",KLNr:"Klant specifieke",1:"nv 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
 
COPYKL New KLNaar,KLVan,%JO,%JN,NewPAKNr,PAKNr
 Set KLNaar=$$SELECT^KLANT6(1,"","Kopieren naar klant : ")
 Quit:'KLNaar
 Quit:KLNaar=KLNr
 Set KLVan=$$ASK^vhINP("Verwijderen pakketen : ",1,"","Alle bestaande pakketten van klant "_$P(^KKL(^KK1(KLNaar),0),D,2)," worden eerste verwijderd.   V[] = Verwijderen, M[]=Merge(zonder verwijder)","","","","U")
 Quit:KLVan'="V"&(KLVan'="M")
 Set IsMerge=$S(KLVan="M":1,1:0)
 Set KLVan=KLNr,KLNr=KLNaar
 Set %JN=$$%J^vhRtn1(),%JO=%J
 Do:IsMerge INIT2(%JN,KLNaar)
 Do:'IsMerge SAVEDEL(KLNaar)
 Set PAKNr=""
 Lock +^PAKKET("N")
 Set NewPAKNr=^PAKKET("N")
 For  Set PAKNr=$O(^HULP(%J,"D",PAKNr)) Quit:PAKNr=""  Do
 .Set PakNm=$P(^HULP(%J,"D",PAKNr),D,2)
 .Quit:PakNm=""
 .Quit:IsMerge&$D(^HULP(%JN,"IN",PakNm))
 .Set NewPAKNr=NewPAKNr+1
 .Merge ^HULP(%JN,"D",NewPAKNr)=^HULP(%J,"D",PAKNr)
 .Set $P(^HULP(%JN,"D",NewPAKNr),D,1)=KLNaar
 Set ^PAKKET("N")=NewPAKNr
 Lock -^PAKKET("N")
 Set %J=%JN
 Do SAVEBLD(%JN,KLNaar)
 Kill ^HULP(%JN)
 Set %J=%JO
 Set KLNr=KLVan
 Quit
 
 
 ; **** DETAIL ****
CBLIST(Nr,Ref) ; Callback voor het scherm
 If $P(Ref,D,3)="L" Quit "L"
 If $P(Ref,D,2) Quit "P"
 Quit ""
 
CBPRINT(Ref) ; Callback voor het scherm
 Quit:$L(Ref)<3 ""
 If $P(@Ref,D,3)="L" Quit ";L"
 If $P(@Ref,D,2) Quit ";P"
 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:PRNr'="L"
 ..Do FETCHPR^UTILI(PRNr)
 ..Set ^HULP(%J,"L",PakNm_" "_$P(B("I"),D,3)_$$COMPR^PRODUKT(PRNr))=PAKNr_D_PRNr
 .Set LPAKNr=""
 .For  Set LPAKNr=$O(^HULP(%J,"D",PAKNr,"L",LPAKNr)) Quit:'LPAKNr  Do
 ..Set ^HULP(%J,"L",PakNm_"~"_$P($G(^PAKKET("D",LPAKNr),D_LPAKNr),D,2))=PAKNr_D_LPAKNr_D_"L"
 Do RL^PROC1
 Do ADD^vhScherm(PAKKET(3),24)
 Quit
 
PRINT New PAKKET
 Do INIT^PROC("PAKKET")
 Set PAKKET(2,"P")=^LD("L","PAKKETP")
 Set PAKKET(2,"L")=^LD("L","PAKKETL")
 Set PAKKET(11)="PAKKETTEN"_D_$S(KLNr:"Klant : "_KLNr_" "_$P(^KKL(^KK1(KLNr),0),D,2),1:"nv eigen")
 Set PAKKET(10)="CBPRINT^PAKKET"
 Do SORT
 Do PRINT^OUTPUT(.PAKKET,"PT","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 ADD^vhScherm(sRT-1,sRB),REFRESH
 Set sS("MOD")=1
 Goto LA2
 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 LPAKNr=""
 For  Set LPAKNr=$O(^HULP(%J,"D",OldPAK,"L",LPAKNr)) Quit:'LPAKNr  Do
 .Set ^HULP(%J,"D",PAKNr,"L",LPAKNr)=""
 .Set ^HULP(%J,"IL",LPAKNr,PAKNr)=""
 Set sS("MOD")=1
 Do ADD^vhScherm(PAKKET(3),24)
 Quit
 
LAPPEND(Lijn) ;Tussen voegen van een produkt
 Set PAKNr=$P(^HULP(%J,"L",Lijn),D)
 Set Type=$$ASKL^vhINP("PAKKET","PRODLINK")
 Quit:"L"'[Type
 Goto:"L"=Type LA3
LA2 Set Index=PAKNr,Data=""
 Do NIEUW^vhScherm("PAKKETPRD")
 Quit:'%SC
 Set ^HULP(%J,"D",PAKNr,$P(Index,D,2))=Data
 Set ^HULP(%J,"IP",$P(Index,D,2),PAKNr)=""
 Do APPENDV^PROC3(Index)
 Do ADD^vhScherm(sRT-1,sRB)
 Set sS("MOD")=1
 Goto LA2
 Quit 
 ; Bijvoegen van een link
LA3 Set LPAKNr=$$SELECT^PAKKETS(KLNr)
 Quit:'LPAKNr
 If $D(^HULP(%J,PAKNr,"L",LPAKNr)) Do TXTL^vhINP("PAKKET","LAPPEXISTPAK") Quit
 Set ^HULP(%J,"D",PAKNr,"L",LPAKNr)=""
 Set ^HULP(%J,"IL",LPAKNr,PAKNr)=""
 Do APPENDV^PROC3(PAKNr_D_LPAKNr_D_"L")
 Set sS("MOD")=1
 Quit
 
SELECT(sFld,Index) ; Wordt opgeroepen vanuit scherm PAKKETPRD
S2 Set PRNr=$$SELECT^PRODUKT6()
 Set sEr=-1
 Quit:'$G(sDir)&'PRNr  ; Wijzig en geen produkt geselekteerd
 If 'PRNr Set X="-",sDir=-1 Quit  ; Nieuw en geen produkt geselekteerd
 If $P(Index,D,2)'=PRNr,$D(^HULP(%J,PAKNr,PRNr)) Do TXTL^vhINP("PAKKET","LAPPEXISTPAK") Goto S2
 Set sDir=1
 Set %SC=1
 Do PUT^vhScherm(sFld,PRNr)
 Quit
 
LWIJZIG(Lijn,Veld) 
 New Index,OldIndex,Data,OldData
 Set (Index,OldIndex)=^HULP(%J,"L",Lijn)
 Set PAKNr=$P(Index,D)
 Set PRNr=$P(Index,D,2)
 Set LPAKNr="" Set:$P(Index,D,3)="L" LPAKNr=PRNr,PRNr=""
 Set %SC=0
 If PRNr Do  ; Produkt aantal wijzigen
 .Set (Data,OldData)=^HULP(%J,"D",PAKNr,PRNr)
 .Do EDIT^vhScherm("PAKKETPRD")
 .Quit:'%SC
 .Kill ^HULP(%J,"D",PAKNr,$P(OldIndex,D,2)),^HULP(%J,"IP",$P(OldIndex,D,2),PAKNr)
 .Set ^HULP(%J,"D",PAKNr,$P(Index,D,2))=Data,^HULP(%J,"IP",$P(Index,D,2),PAKNr)="",^HULP(%J,"L",Lijn)=Index
 Else  If LPAKNr Do  ; Pakket link wijzigen
 .Set X=$$SELECT^PAKKETS(KLNr)
 .Quit:'X
 .If X'=LPAKNr,$D(^HULP(%J,PAKNr,"L",X)) Do TXTL^vhINP("PAKKET","LAPPEXISTPAK") Quit
 .Kill ^HULP(%J,"D",PAKNr,"L",LPAKNr)
 .Kill ^HULP(%J,"IL",LPAKNr,PAKNr)
 .Set LPAKNr=X
 .Set ^HULP(%J,"D",PAKNr,"L",LPAKNr)=""
 .Set ^HULP(%J,"IL",LPAKNr,PAKNr)=""
 .Set $P(Index,D,2)=LPAKNr,^HULP(%J,"L",Lijn)=Index
 .Set %SC=1
 Else  Do  ; Pakketnaam wijzigen
 .Do EDIT^vhScherm("PAKKETHFD")
 Quit:'%SC
 Do EL^PROC
 Set sS("MOD")=1
 Quit
 
LDELETE(Lijn) 
 Set PAKNr=$P(^HULP(%J,"L",Lijn),D)
 Set PRNr=$P(^HULP(%J,"L",Lijn),D,2)
 Set LPAKNr=""
 Set:$P(^HULP(%J,"L",Lijn),D,3)="L" LPAKNr=PRNr,PRNr=""
 If PRNr Do
 .If $O(^HULP(%J,"D",PAKNr,""))=$O(^HULP(%J,"D",PAKNr,""),-1) Do TXTL^vhINP("PAKKET","LDELNOPROD")
 .Kill ^HULP(%J,"IP",PRNr,PAKNr),^HULP(%J,"D",PAKNr,PRNr)
 .Do DELETE^PROC3
 Else  If LPAKNr Do
 .Kill ^HULP(%J,"IL",LPAKNr,PAKNr),^HULP(%J,"D",PAKNr,"L",LPAKNr)
 .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 sS("MOD")=1
 Quit
 
RPLPR(Lijn)  
 Set Rec=$G(^HULP(%J,"L",Lijn))
 Quit:'$P(Rec,D,2)!($P(Rec,D,3)="L")
 Set ScreenPR=$$RAADPL^PRODUKT($P(Rec,D,2),$P(ScreenPR,D,1))
 Do ADD^vhScherm(1,24)
 Quit
RPLKL 
 Quit:$G(Extern)
 Set ScreenKL=$$RAADPL^KLANT(KLNr,$P(ScreenKL,D,1),1)
 Do ADD^vhScherm(1,24)
 Quit
IMPORT 
 Do ^PAKKETI
 Quit
NEXTID() 
 New PAKNr
 Lock +^PAKKET("N")
 Set PAKNr=$G(^PAKKET("N"))+1,^PAKKET("N")=PAKNr
 Lock -^PAKKET("N")
 Quit PAKNr
 
 ; PakNm doorgegeven als .Local(PakNm)=Omschrijving
 ; PRNr doorgegeven als .Local(PRNr)=Aantal
LIMPORT(KLNr,PakNm,PRNr,DelFirst)
 New R,PakOms,PAKNr,PakOms,Aantal
 For  Do ADD^vhLock("^PAKKET(""IK"",KLNr)") Quit:%TC  Do LDISP^vhLock("^PAKKET(""IK"",KLNr)","Pakketten bestand")
 
 
 Set PakNm=""
 For  Set PakNm=$O(PakNm(PakNm)) Quit:PakNm=""  Do
 . ;Delete
 . If $G(DelFirst) Do
 . . Set PAKNr=$G(^PAKKET("IK",KLNr,$$UPTRIMAN^vhRtn1(PakNm)))
 . . Quit:'PAKNr
 . . Do DELOBJ(PAKNr)
 . ; Build
 . Set PAKNr=$G(^PAKKET("IK",KLNr,$$UPTRIMAN^vhRtn1(PakNm)))
 . Set:'PAKNr PAKNr=$$NEXTID()
 . Set PakOms=$P(PakNm(PakNm),D)
 . Set:'$D(^PAKKET("D",PAKNr)) ^PAKKET("D",PAKNr)=KLNr_D_PakNm_"\D\"_PakOms
 . Set ^PAKKET("IK",KLNr,$$UPTRIMAN^vhRtn1(PakNm))=PAKNr
 . Set PRNr=""
 . For  Set PRNr=$O(PRNr(PRNr)) Quit:PRNr=""  Do
 . . Quit:$D(^PAKKET("D",PAKNr,PRNr))
 . . Set R=PRNr(PRNr),Aantal=$P(R,D)
 . . Set ^PAKKET("D",PAKNr,PRNr)=Aantal_"\\"
 . . Set ^PAKKET("IP",PRNr,KLNr,PAKNr)=""
 Lock -^PAKKET("IK",KLNr)
 Quit
 
 ; Conctrole van de PAKKET-global
CheckPakket
 New R,PakkerNr,KLNr,PakketNaam,PRNr
 Set PakketNr=""
 For  Set PakketNr=$O(^PAKKET("D",PakketNr)) Quit:PakketNr=""  Do
 . Set R=^PAKKET("D",PakketNr),KLNr=$P(R,D),PakketNaam=$P(R,D,2)
 . If '$D(^PAKKET("IK",KLNr,$$UPTRIMAN^vhRtn1(PakketNaam))) Write !,$ZR," - onbekend"
 . Else  If $G(^PAKKET("IK",KLNr,$$UPTRIMAN^vhRtn1(PakketNaam)))'=PakketNr Write !,$ZR," - ",PakketNr," - ",^PAKKET("IK",KLNr,$$UPTRIMAN^vhRtn1(PakketNaam))
 . Set PRNr=""
 . For  Set PRNr=$O(^PAKKET("D",PakketNr,PRNr)) Quit:PRNr=""  If '$D(^PAKKET("IP",PRNr,KLNr,PakketNr)) Write !,$ZR," - onbekend"
 Set PRNr=""
 For  Set PRNr=$O(^PAKKET("IP",PRNr)) Quit:PRNr=""  Do
 . Set KLNr=""
 . For  Set KLNr=$O(^PAKKET("IP",PRNr,KLNr)) Quit:KLNr=""  Do
 . . Set PakketNr=""
 . . For  Set PakketNr=$O(^PAKKET("IP",PRNr,KLNr,PakketNr)) Quit:PakketNr=""  If '$D(^PAKKET("D",PakketNr,PRNr)) Write !,$ZR," - onbekend"
 Set KLNr=""
 For  Set KLNr=$O(^PAKKET("IK",KLNr)) Quit:KLNr=""  Do
 . Set PakketNaam=""
 . For  Set PakketNaam=$O(^PAKKET("IK",KLNr,PakketNaam)) Quit:PakketNaam=""  Do
 . . Set PakketNr=^PAKKET("IK",KLNr,PakketNaam)
 . . If '$D(^PAKKET("D",PakketNr)) Write !,$ZR," - onbekend"
 . . Else  If PakketNaam'=$$UPTRIMAN^vhRtn1($P(^PAKKET("D",PakketNr),D,2)) Write !,$ZR," - ",PakketNr," - ",PakketNaam," - ",^PAKKET("D",PakketNr)
 Quit