pvPAKKET ;Pakket : Wijzigen [ 12/03/2002  4:19 PM ]
 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, [] = N.V. 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) ; Ophalen van product referenties voor een bep. klant en product
 New PAKNr,Ref,Str
 Set PAKNr=""
 Set Str=""
 For  Set PAKNr=$O(^PAKKET("IP",PRNr,KLNr,PAKNr)) Quit:PAKNr=""  Do
 .Set Ref=$P($G(^PAKKET("D",PAKNr)),D,2)
 .Set:$L(Ref) Str=";"_Ref
 Quit $E(Str,2,99)
 
 
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 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 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)=""
 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) ; Locks en 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
 Do SAVEBLD
 Quit
SAVEDEL ; Verwijderen van alle pakketten van die klant
 Set Nm=""
 For  Set Nm=$O(^PAKKET("IK",KLNr,Nm)) Quit:Nm=""  Do DELOBJ(^(Nm))
 Quit
SAVEBLD ; 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
 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
 
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","","","","U")
 Quit:KLVan'="V"
 Set KLVan=KLNr,KLNr=KLNaar
 Set %JN=$$%J^vhRtn1(),%JO=%J
 Kill ^HULP(%JN)
 Write "INIT",! r k
 Do INIT2(%JN,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:$D(^HULP(%JN,"IN",PakNm))
 .Write PakNm,! r k
 .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
 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:"N.V. 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