KLASB ;Klassificatie (beheer) ; [ 09/10/2003  3:55 PM ]
 ;
 If '$$INIT() Quit
 Do ADD^vhScherm(1,1)
KLAS1 Do COMMAND,SAVE^KLAS:$$FR^DD("hPRKL"),CLEAN
 Quit
 ;
COMMAND Set Input=""
 For  Quit:Input="-"!(Input=".")  Do
 .Do REFRESH,SL^PROC
 .Set Input=R
 .Do SELECT
 .If Input="COM" Set Input="" Do CALL^vhMenu("KLAS")
 .Set:Input="CANC" Input="-"
 .Do EXEC^vhMenu("KLAS",.Input)
 .If Input="K",NivNr<4 Set Input="" Do KLANTEN("")
 .If Input?1N,NivNr>2 Do ^PVKLAS(NivNr,KKey,$G(PRNr),Input)
 .If Input="," Do
 ..If NivNr=1 Set Input="-"
 ..If NivNr=2 Set Input="H"
 ..If NivNr=3 Set Input="G"
 ..If NivNr=4 Set Input="S"
 .If Input="-"!(Input="."),$$FR^DD("hPRKL") Set Input=$$SAVE^vhINP(1)
 .If Input="ENTER",NivNr<4 Do @$P("GROEP;SUBGROEP;PRODUKT;RPLPR(""P"")",";",NivNr)
 .If Input="H",NivNr'=1 Do HOOFDGR
 .If Input="G",NivNr'=2 Do GROEP
 .If Input="S",NivNr>1,NivNr'=3 Do SUBGROEP
 .If Input="P",NivNr=4 Do RPLPR("P")
 .If Input="K",NivNr=4 Do KSPAK
 .If Input="P",NivNr=3 Do PRODUKT
 .If Input="(",NivNr>1 Do MOVE(-1)
 .If Input=")",NivNr>1 Do MOVE(1)
 .If NivNr<4 Do
 ..If Input="N" Do NIEUW
 ..If Input="I" Do INSERT
 ..If Input="V" Do DELETE
 ..If Input="W" Do EDITEER
 ..If Input="<" Do SWAPUP
 ..If Input=">" Do SWAPDOWN
 Do SR^DD("hPRKL",$$FR^DD("hPRKL")&(Input="-"))
 Quit
 ;
MOVE(Dir) 
 Set NivTemp=NivNr
 Set THNr=KHNr,TGNr=KGNr,TSNr=KSNr
MOVE2 If NivTemp=4 Set KSNr=$$ORN^DD("hPRKLS","",Dir) Set:'KSNr NivTemp=NivTemp-1
 If NivTemp=3 Set KGNr=$$ORN^DD("hPRKLG","",Dir) Set:'KGNr NivTemp=NivTemp-1
 If NivTemp=2 Set KHNr=$$ORN^DD("hPRKLH","",Dir) If 'KHNr Set KHNr=THNr,KGNr=TGNr,KSNr=TSNr Quit
 If NivNr>NivTemp Set NivTemp=NivTemp+1 Goto MOVE2
 Set HG(6)=KHNr,GR(6)=KGNr,SG(6)=KSNr
 
 Goto PRODUKT:NivNr=4,SUBGROEP:NivNr=3,GROEP:NivNr=2
 Quit
 
INIT() 
 New %TC
 Set NivNr=0,%J=$$%J^vhRtn1()
 Write @F11,@F1
 Do ADD^vhScherm(1,1),REFRESH
 Do ADD^vhLock("^KLAS") If '%TC Do LDISP^vhLock("^KLAS","Classificatie") Quit 0
 If $D(^KLAS("M")) Do  Quit 0
 .Set FP=2001 Write @F,@F1
 .Write !,"*******  U kunt nu niet werken met BEHEER CLASSIFICATIE  *******"
 .Write !,"Bij de vorige opbouw van het classificatie bestand is er een fout opgetreden"
 .Write !,"Gelieve dringend de systeem beheerder te verwittigen (Paul V., Tel. 47)"
 .R *K
 Do KR^DD("hPRKL")
 Do INIT^PROC("KLASSG","SG")
 Do INIT^PROC("KLASGR","GR")
 Do INIT^PROC("KLASHG","HG")
 Do INIT^PROC("KLASKL","KL")
 Set (HKey,GKey,SKey)=""
 Set (KHNr,KSNr,KGNr)=""
 Do INIT^KLAS
 Quit 1
 ;
CLEAN Do KR^DD("hPRKL")
 Lock
 Quit
 
SELECT 
 If NivNr=4,NivKode="P" Set PRNr="" Set:$D(^HULP(%J,"P",KLASP(6))) PRNr=^HULP(%J,"P",KLASP(6))
 Quit:NivNr'<4
 Set @("K"_NivKode_"Nr")=@DL(1)@(6)
 If '$$DRN^DD("hPRKL"_NivKode) Set R=NivKode Quit
 Set KKey=$$FF^DD("hPK"_NivKode_"Key")
 Quit
 ;
HOOFDGR 
 Set NivNr=1,NivKode="H"
 Kill DL,HG(9) Set DL(1)="HG"
 Do ADD^vhScherm(1,24)
 Quit
 ;
GROEP 
 Set KKey=$$GF^DD("hPKHKey") Quit:'KKey
 Set NivNr=2,NivKode="G"
 If KKey'=HKey Set (GR(6),GR(7),SG(6),SG(7))=1
 Set HKey=KKey
 Kill DL,GR(9) Set DL(1)="GR"
 Do ADD^vhScherm(1,24)
 Quit
 ;
 
SUBGROEP 
 Set KKey=$$GF^DD("hPKGKey") Quit:'KKey
 Set NivNr=3,NivKode="S"
 If KKey'=GKey Set (SG(6),SG(7))=1 Kill SG(9)
 Set GKey=KKey
 Kill DL,SG(9) Set DL(1)="SG"
 Do ADD^vhScherm(1,24)
 Quit
 ;
SWAPUP 
 If @DL(1)@(6)=1 Set R=NivKode Quit
 Do SWAP^PROC3("UP")
 ; Markeer voor de twee gewisselde alle onderliggende modified
 Do MODIFIED(@DL(1)@(6)),MODIFIED(@DL(1)@(6)+1)
 Quit
 ;
SWAPDOWN 
 If @DL(1)@(6)=@DL(1)@(9) Set R=NivKode Quit
 Do SWAP^PROC3("DO")
 ; Markeer voor de twee gewisselde alle onderliggende modified
 Do MODIFIED(@DL(1)@(6)),MODIFIED(@DL(1)@(6)-1)
 Quit
 ;
MODIFIED(Nr) 
 If NivNr=1 Do  Quit
 .Set KHNr=Nr
 .Do SF^DD("hPKHMod",1),SR^DD("hPRKL",1)
 .Set KGNr=""
 .For  Set KGNr=$$ORN^DD("hPRKLG") Quit:KGNr=""  Do
 ..Do SF^DD("hPKGMod",1),SR^DD("hPRKL",1)
 ..Set KSNr=""
 ..For  Set KSNr=$$ORN^DD("hPRKLS") Quit:KSNr=""  Do
 ...Do SF^DD("hPKSMod",1),SR^DD("hPRKL",1)
 If NivNr=2 Do  Quit
 .Set KGNr=Nr
 .Do SF^DD("hPKGMod",1),SR^DD("hPRKL",1)
 .Set KSNr=""
 .For  Set KSNr=$$ORN^DD("hPRKLS") Quit:KSNr=""  Do
 ..Do SF^DD("hPKSMod",1),SR^DD("hPRKL",1)
 If NivNr=3 Do  Quit
 .Set KSNr=Nr
 .Do SF^DD("hPKSMod",1),SR^DD("hPRKL",1)
 Quit
 ;
EDITEER 
 If '$$DRN^DD("hPRKL"_NivKode) Quit
 Set MemKode=$$FF^DD("hPKKKode")
 Do EDIT^vhScherm("KLAS"_NivKode)
 If %SC Do
 .If $$FF^DD("hPK"_NivKode_"Mod")'=1 Do SF^DD("hPK"_NivKode_"Mod",MemKode=$$FF^DD("hPKKKode")+1)
 .If $$FF^DD("hPK"_NivKode_"Mod")=1 Do MODIFIED(@("K"_NivKode_"Nr"))
 .Do SR^DD("hPRKL",1)
 Do ADD^vhScherm(1,24)
 Quit
 ;
NIEUW 
 Set R="" If NivNr>1 Set KKey=$$FF^DD("hPK"_$P("H\G",D,NivNr-1)_"Key"),R=$P($$FR^DD("hPRKLK"),D,1,3)
 Set KKey=$$FF^DD("oPKLstK")
 Do SF^DD("oPKLstK",KKey+1)
 Do SR^DD("hPRKLK",R)
 Set @DL(1)@(9)=@DL(1)@(9)+1
 If $$DRN^DD("hPRKL"_NivKode) Do DL^PROC
 Set (@("K"_NivKode_"Nr"),@DL(1)@(6))=@DL(1)@(9)
 Do LNIEUW^PROC3(@DL(1)@(9),@DL(1)@(1),KKey)
 Do EL^PROC
 Do LNIEUW
 Quit
 ;
LNIEUW 
 Do NIEUW^vhScherm("KLAS"_NivKode)
 If '%SC Do DELETE^PROC3,KR^DD("hPRKLK") Quit
 Do SF^DD("hPK"_NivKode_"Mod",1),SR^DD("hPRKL",1)
 If $$DRN^DD("hPRKL"_NivKode),@DL(1)@(3)+@DL(1)@(6)-@DL(1)@(7)<13 Do EL^PROC
 ; Markeer alle volgende modified
 If NivNr=1 Do
 .For  Set KHNr=$$ORN^DD("hPRKLH") Quit:KHNr=""  Do
 ..Do MODIFIED(KHNr)
 If NivNr=2 Do
 .For  Set KGNr=$$ORN^DD("hPRKLG") Quit:KGNr=""  Do
 ..Do MODIFIED(KGNr)
 If NivNr=3 Do
 .For  Set KSNr=$$ORN^DD("hPRKLS") Quit:KSNr=""  Do
 ..Do MODIFIED(KSNr)
 Quit
 ;
INSERT 
 If '$$DRN^DD("hPRKL"_NivKode) Set R=NivKode Quit
 Set R="" If NivNr>1 Set KKey=$$FF^DD("hPK"_$P("H\G",D,NivNr-1)_"Key"),R=$P($$FR^DD("hPRKLK"),D,1,3)
 Set KKey=$$FF^DD("oPKLstK")
 Do SF^DD("oPKLstK",KKey+1)
 Do SR^DD("hPRKLK",R)
 Do LINSERT^PROC3(@DL(1)@(6),@DL(1)@(9),@DL(1)@(1),KKey)
 Set @DL(1)@(9)=@DL(1)@(9)+1
 Kill DL(3) Set DL(2)=@DL(1)@(6)-@DL(1)@(7)+@DL(1)@(3) Do WL^PROC
 Do LNIEUW
 Quit
 ;
DELETE 
 New NoDel
 If '$$DRN^DD("hPRKL"_NivKode) Set R=NivKode Quit
 Set KKey=$$FF^DD("hPKHKey")
 If $$DRN^DD("oPRKLK") Do
 .Set KHS=$$GETSORT^KLASS(KKey)
 .If NivNr=1 Do  Quit
 ..If $D(^KPH(KHS)) Do NODELETE Quit:$D(NoDel)
 ..If $D(^KLPUTZ("IN",KHS)) Do HEEFTUIT("N") Quit:$D(NoDel)
 ..If $D(^KLPUTZ("IS",KHS)) Do HEEFTUIT("S") Quit:$D(NoDel)
 .Set KKey=$$FF^DD("hPKGKey")
 .If $$DRN^DD("oPRKLK") Do
 ..Set KGS=$$GETSORT^KLASS(KKey)
 ..If NivNr=2 Do  Quit
 ...If $D(^KPH(KHS,KGS)) Do NODELETE Quit:$D(NoDel)
 ...If $D(^KLPUTZ("IN",KHS,KGS)) Do HEEFTUIT("N") Quit:$D(NoDel)
 ...If $D(^KLPUTZ("IS",KHS,KGS)) Do HEEFTUIT("S") Quit:$D(NoDel)
 ..Set KKey=$$FF^DD("hPKSKey")
 ..If $$DRN^DD("oPRKLK") Do
 ...Set KSS=$$GETSORT^KLASS(KKey)
 ...If NivNr=3 Do  Quit
 ....If $D(^KPH(KHS,KGS,KSS)) Do NODELETE Quit:$D(NoDel)
 ....If $D(^KLPUTZ("IN",KHS,KGS,KSS)) Do HEEFTUIT("N") Quit:$D(NoDel)
 ....If $D(^KLPUTZ("IS",KHS,KGS,KSS)) Do HEEFTUIT("S") Quit:$D(NoDel)
 If $D(NoDel) Do ADD^vhScherm(1,24) Set R=NivKode Quit
 ; Verwijder alle onderliggende
 If NivNr=1 Do
 .Set KGNr=""
 .For  Set KGNr=$O(^HULP(%J,"D",KHNr,KGNr)) Quit:KGNr=""  Do
 ..Set KSNr=""
 ..For  Set KSNr=$O(^HULP(%J,"D",KHNr,KGNr,KSNr)) Quit:KSNr=""  Do
 ...Set KKey=$$FF^DD("hPKSKey")
 ...Do KR^DD("hPRKLK")
 ..Set KKey=$$FF^DD("hPKGKey")
 ..Do KR^DD("hPRKLK")
 If NivNr=2 Do
 .Set KSNr=""
 .For  Set KSNr=$O(^HULP(%J,"D",KHNr,KGNr,KSNr)) Quit:KSNr=""  Do
 ..Set KKey=$$FF^DD("hPKSKey")
 ..Do KR^DD("hPRKLK")
 Set KKey=$$FF^DD("hPK"_NivKode_"Key")
 Do KR^DD("hPRKLK")
 Do SR^DD("hPRKL",1)
 ; Markeer alle volgende modified
 If NivNr=1 Do
 .For  Set KHNr=$$ORN^DD("hPRKLH") Quit:KHNr=""  Do
 ..Do MODIFIED(KHNr)
 If NivNr=2 Do
 .For  Set KGNr=$$ORN^DD("hPRKLG") Quit:KGNr=""  Do
 ..Do MODIFIED(KGNr)
 If NivNr=3 Do
 .For  Set KSNr=$$ORN^DD("hPRKLS") Quit:KSNr=""  Do
 ..Do MODIFIED(KSNr)
 Do DELETE^PROC3
 Set R=NivKode
 Quit
 ;
NODELETE 
 Set FP=2403 Write @F,@F1,@FMTI," Er bestaan nog producten voor deze "
 Write $P("hoofd\\sub",D,NivNr),"groep  [] = ok ",@FMTi
 Kill IK Do IK^PROC1
 Set NoDel=1
 Quit
 ;
HEEFTUIT(NoSa) 
 New Text
 Set:NoSa="N" NoSa=""
 Set Text="Er bestaan "_$P("shaduw",D,$L(NoSa))_"uitzonderingen voor deze "_$P("hoofd\\sub",D,NivNr)_"groep : "
 For  Do  If $L(R),"NO"[R Quit
 .Set R=$$ASK^vhINP(Text,1,"","  n[] = niet verwijderen   o[] = opkuisen   k[] = Klantenoverzicht","",3)
 .Set R=$$UPCASE^vhRtn1(R)
 .If R="K" Do KLANTEN(NoSa)
 If R'="O" Set NoDel=1 Quit
 Quit
 ;
KLANTEN(NoSa) 
 If '$$DRN^DD("hPRKL"_NivKode) Quit
 New KlantInd,KortText,Input
 Do OLDKEY
 Do FETCHUTZ(KL(1),NoSa,NivNr,KHS,KGS,KSS)
 Do
 .New NivKode,DL
 .Set NivNr=NivNr+1,NivKode="K"
 .Kill DL,KL(9) Set DL(1)="KL"
 .Set (KL(6),KL(7))=1
 .Do ADD^vhScherm(1,24),REFRESH
 .If '$D(^HULP(%J,"U")) Do OPMERK("Geen klanten gevonden voor deze "_$P("hoofd\\sub",D,NivNr-1)_"groep")
 .For  Do  Quit:Input="-"!(Input=",")
 ..Do SL^PROC
 ..Set Input=R
 ..If Input="COM" Set Input="" Do CALL^vhMenu("KLASK")
 ..Set:Input="CANC" Input="-"
 ..Do EXEC^vhMenu("KLASK",.Input)
 ..If Input="K" Do RPLKL
 ..If Input="P" Do RPLPR("U")
 ..Do REFRESH
 .Set NivNr=NivNr-1
 Do ADD^vhScherm(1,24)
 Quit
 ;
FETCHUTZ(HULP,NoSa,NivNr,KHS,KGS,KSS,PRNr) ; Ophalen prijsuitzonderingen
 New Key,KLNr,String,KlantInd,R,Nr
 Set:'$L($G(NoSa)) NoSa="N"
 Set:$E(HULP,$L(HULP))="," $E(HULP,$L(HULP))=")"
 Set:$E(HULP,$L(HULP))'=")" HULP=HULP_")"
 Set Lim=0
 If NivNr=5 S NivNr=1,Lim=1,LGS=KGS,LSS=KSS,LRNr=PRNr
 Kill @HULP
 Set (KLNr,String)=""
 For  Set KLNr=$O(^KLPUTZ(NoSa,KLNr)) Quit:KLNr=""  Do
 .Quit:'$D(^KK1(KLNr))
 .If NivNr=1,'$D(^KLPUTZ(NoSa,KLNr,KHS)) Quit
 .If NivNr=2,'$D(^KLPUTZ(NoSa,KLNr,KHS,KGS)) Quit
 .If NivNr=3,'$D(^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS)) Quit
 .If NivNr=4,'$D(^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS,PRNr)) Quit
 .Set Fetch=0
 .Set KlantInd=^KK1(KLNr),R=^KKL(KlantInd,0)
 .Set String=$P(R,D,1,2)_D_$P(R,D,7)
 .Set R=^KKL(KlantInd,2),$P(String,D,4)=$P(R,D,3)
 .Set $P(String,D,5)=KHS
 .If NivNr<2 Set KGS=""
 .For  Set:NivNr<2 KGS=$O(^KLPUTZ(NoSa,KLNr,KHS,KGS)) Quit:KGS=""  Do  Quit:NivNr>1
 ..If Lim,KGS Quit:KGS'=LGS
 ..Set $P(String,D,6)=$S(KGS=0:"",1:KGS)
 ..If NivNr<3 Set KSS=""
 ..For  Set:NivNr<3 KSS=$O(^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS)) Quit:KSS=""  Do  Quit:NivNr>2
 ...If Lim,KSS Quit:KSS'=LSS
 ...Set $P(String,D,7)=$S(KSS=0:"",1:KSS)
 ...If NivNr<4 Set PRNr=""
 ...For  Set:NivNr<4 PRNr=$O(^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS,PRNr)) Quit:PRNr=""  Do  Quit:NivNr>3
 ....If Lim,PRNr Quit:PRNr'=LRNr
 ....Set KortText="" If PRNr,$D(^KPR(PRNr)) Set KortText=$P(^KPR(PRNr,0),D)
 ....Set $P(String,D,8)=$S(PRNr:PRNr,1:""),$P(String,D,9)=KortText
 ....Set $P(String,D,10)=^($O(^KLPUTZ(NoSa,KLNr,KHS,KGS,KSS,PRNr,"")))
 ....Set @HULP@(KlantInd,KHS_KGS_KSS_$$COMPR^PRODUKT(PRNr))=$E(String,1,500) ;,String=$P(String,D,1)
 ....Set Fetch=1
 .;Set:Fetch @HULP@(KlantInd_"zzzzzzzzzzzz")=""
 Set Nr=0,Key="",KlantInd="",First=1
 For  Set KlantInd=$O(@HULP@(KlantInd)) Quit:KlantInd=""  Do
 .For  Set Key=$O(@HULP@(KlantInd,Key)) Quit:Key=""  Do
 ..Set R=^(Key)
 ..Set:'First $P(R,D,2,4)="\\"
 ..Set First=0
 ..Set Nr=Nr+1,@HULP@(Nr)=R
 .Set First=1
 .Kill @HULP@(KlantInd)
 .Set Nr=Nr+1,@HULP@(Nr)=""
 Quit
 ;
REFRESH 
 New KKey
 If sRT=1 Do
 .Write @F11,@FMTI," BEHEER KLASSIFICATIE ",QN," ",@FMTi,@F2
 .If NivNr=0 Set FP=160 Write @F,@FMTK,"Initialisatie",@FMTk
 .If NivNr'=0 Do
 ..Set T=$P("HOOFDGROEP\GROEP\SUBGROEP\PRODUCT\KLANTEN","\",$F("HGSPK",NivKode)-1)
 ..If NivKode="K" Set T=T_$S(NoSa="":" ",1:" SCHADUW ")_"PRIJSUITZ."
 ..Set FP=178-$L(T) Write @F,@FMTB," ",T," ",@FMTb
 If sRT<5,sRB>1 Do
 .Set FP=201 Write @F,@F2
 .Write !," Classificatie : "
 .If NivNr>1 Set KKey=$$FF^DD("hPKHKey")  Write $$FF^DD("hPKKKode")
 .If NivNr>2 Set KKey=$$FF^DD("hPKGKey")  Write "-",$$FF^DD("hPKKKode")
 .If NivNr>3 Set KKey=$$FF^DD("hPKSKey")  Write "-",$$FF^DD("hPKKKode")
 .If NivNr>1 Write "    ",$$FF^DD("hPKKOmsN")
 .If (NivNr>1)  Do
 ..W "  ("_$$FF^DD("hPKHKey")
 ..If (NivNr>2) W "-"_$$FF^DD("hPKGKey")
 ..If (NivNr>3) W "-"_$$FF^DD("hPKSKey")
 ..W ")"
 .Write @F2,!,@F2
 Kill FL
 If sRB>4 Kill DL(2),DL(3) Set:sRT>5 DL(2)=sRT Set:sRB<24 DL(3)=sRB Do WL^PROC Kill DL(2),DL(3)
 Do RESET^vhScherm
 Quit
 
KSPAK Quit:'PRNr
 Lock +^KPR(PRNr):1 
 Else  Do DISPL^cLOCK($NA(^KPR(PRNr)),"Product") Quit
 Do NIEUW^vhScherm("KLASKSPAK",,,,,,3)
 Lock -^KPR(PRNr)
 Quit
 ;
PRODUKT 
 Set KKey=$$GF^DD("hPKSKey") Quit:'KKey
 Set NivNr=4,NivKode="P"
 Set Kort=" "
 Do OLDKEY
 Do INIT^PROC("KLASP") 
 Set KLASP(9)=$$MORE(0,KLASP(4),"")
 Do ADD^vhScherm(1,24),REFRESH,RESET^vhScherm
 If '$D(^HULP(%J,"P")) Do OPMERK("Geen producten gevonden voor deze subgroep")
 Quit
 ;
OLDKEY 
 Set (KHS,KGS,KSS)=" "
 Set KKey=$$FF^DD("hPKHKey") Set:$$DRN^DD("oPRKLK") KHS=$$GETSORT^KLASS(KKey)
 If NivNr>1 Set KKey=$$FF^DD("hPKGKey") Set:$$DRN^DD("oPRKLK") KGS=$$GETSORT^KLASS(KKey)
 If NivNr>2 Set KKey=$$FF^DD("hPKSKey") Set:$$DRN^DD("oPRKLK") KSS=$$GETSORT^KLASS(KKey)
 Quit
 ;
MORE(Max,Len,Ref) 
 Quit:$G(Kort)=-1 Max
 If 'Max Set Kort="" Kill ^HULP(%J,"P")
 Set Count=0
 For  Quit:Count'<Len  Set Kort=$O(^KPH(KHS,KGS,KSS,"  ",Kort)) Quit:Kort=""  Do
 .Set Count=Count+1
 .Set ^HULP(%J,"P",Max+Count)=^KPH(KHS,KGS,KSS,"  ",Kort)
 Set:Kort="" Kort=-1
 Quit Max+Count
 ;
RPLKL   
 Quit:'$D(^HULP(%J,"U",KL(6)))  Set KLNr=$P(^HULP(%J,"U",KL(6)),D) Quit:KLNr=""
 Set KScreen=$P($$RAADPL^KLANT(KLNr,$G(KScreen),1),D)
 Do ADD^vhScherm(1,24),REFRESH
 Quit
 ;
RPLPR(List) 
 If List=("P") Quit:'PRNr
 Else  Quit:'$D(^HULP(%J,"U",KL(6)))  Set PRNr=$P(^HULP(%J,"U",KL(6)),D,8) Quit:PRNr=""
 For  Do  Quit:List'="P"!(Aktie="")
 .Set R=$$RAADPL^PRODUKT(PRNr,$G(PScreen),1)
 .Set PScreen=$P(R,D),Aktie=$P(R,D,3)
 .Quit:List'="P"!(Aktie="")
 .Set (PRNr,Aktie)=$$NEXTPROD(Aktie)
 Do ADD^vhScherm(1,24),REFRESH
 Quit
 ;
NEXTPROD(Dir) 
 New Next
 Set Dir=$S(Dir="N":1,1:-1)
 Set Next=$O(^HULP(%J,"P",KLASP(6)),Dir)
 If Next="" Quit ""
 Set KLASP(6)=Next Kill KLASP(7)
 Quit ^HULP(%J,"P",Next)
 ;
OPMERK(T) 
 Set FP=2401 Write @F,@F1,@FMTI," ",T," ",@FMTi,@F0
 Quit
 ;
 ; Bevestig het wijzigen van de grootteorde
MODGRORD(KKey,sFL,NewGrOrd,NoSa) 
 New %R,%C,R,X,prompt,zb,urv,sSetting,sExitKey,xc,sTimeOut,in,ln,Ok,Txt,Count,Bevest,OldGrOrd,SubGr,UserName,MaxLen
 Do STORE^vhTERMINA()
 Set NoSa=$G(NoSa) Set:NoSa'="S" NoSa="N" Set R=$G(^KLAS("K",KKey)),Ok=1
 Do:$L(R)
 .If '$G(CUserId) New CUserId Set CUserId=$$DEVUSER^vhUSER($$IO^cQ5)
 .Set UserName=$$USERNAME^vhUSER(CUserId)
 .Set Count=0,Bevest=UserName_" bevestigt de "_$S(NoSa="S":"schaduw",1:"")_"ingave."
 .Set SubGr=$P(sFL(1),D,10),OldGrOrd=$P(R,D,14+(NoSa="S"))
 .Set:OldGrOrd="" OldGrOrd="E" Set:NewGrOrd="" NewGrOrd="E"
 .Quit:OldGrOrd=NewGrOrd
 .Set Count=Count+1,Txt(Count)=UserName_" aandacht!!!"
 .Set Count=Count+1,Txt(Count)=""
 .If NoSa="N" Do
 ..Set R="Alle producten van de subgroep ŞB"_SubGr_"Şb veranderen"
 ..Set Count=Count+1,Txt(Count)=R
 ..Set R="van grootteorde ŞB"_$S(OldGrOrd="M":"duizend",OldGrOrd="H":"honderd",1:"eenheid")
 ..Set R=R_"Şb naar ŞB"_$S(NewGrOrd="M":"duizend",NewGrOrd="H":"honderd",1:"eenheid")_"Şb."
 ..Set Count=Count+1,Txt(Count)=R
 .Else  Do
 ..Set R="Bij het doorvoeren van de schaduwgegevens zullen"
 ..Set Count=Count+1,Txt(Count)=R
 ..Set R="alle producten van de subgroep ŞB"_SubGr_"Şb veranderen"
 ..Set Count=Count+1,Txt(Count)=R
 ..Set R="van grootteorde ŞB"_$S(OldGrOrd="M":"duizend",OldGrOrd="H":"honderd",1:"eenheid")
 ..Set R=R_"Şb naar ŞB"_$S(NewGrOrd="M":"duizend",NewGrOrd="H":"honderd",1:"eenheid")_"Şb."
 ..Set Count=Count+1,Txt(Count)=R
 .Set Count=Count+1,Txt(Count)=""
 .Set R="Weet u zeker dat u deze wijziging wil doorvoeren?"
 .Set Count=Count+1,Txt(Count)=R
 .Set R="Indien ja, gelieve dan volgende tekst in te geven."
 .Set Count=Count+1,Txt(Count)=R
 .Set Count=Count+1,Txt(Count)="ŞB"_Bevest_"Şb"
 .Set Count=Count+1,Txt(Count)="&S"
 .Set Count=Count+1,Txt(Count)=""
 .Set MaxLen=0
 .For Count=1:1:Count Do
 ..Set R=Txt(Count)
 ..Set R=$E(R,1,$L(R)-($L(R,"Ş")-1*2))
 ..Set:$L(R)>MaxLen MaxLen=$L(R)
 .Do:NoSa="S"
 ..Set R=Txt(1),$E(R,MaxLen-14)="ŞBSchaduwgegevensŞb",Txt(1)=R
 .Set Txt="Txt",R=$$WILD^vhTXTPOP("","",.Txt,,-1,0,1)
 .New FMTI
 .Set %R=16,%C=40-$J(MaxLen/2,0,0),ln=$L(Bevest),X="",FP=%R*100+%C,FMTI=FMTi
 .Write @F,@F5,@F,$J("",ln),!!
 .Do ^vhINP
 .Set Ok=X=Bevest
 Do REFRESH^vhTERMINA()
 Quit Ok
 ;