KLASS ;NEW PROGRAM [ 06/18/2002  11:38 AM ]
 S Q="K" d ^cA604
 s R=$$SELECT(-3,1,11,2)
 w !,R
 Quit
 ; Niv : Niveau tot waar de selectie moet gebeuren 1=HfdGrp,2=Grp,3=SubGrp,4=Prod
 ; LimProd : Boolean indien true dan kan men alleen selecteren indien bestaande in het produkten bestand
 ; DefKey : Default Klassificatie key
 ; DefNiv : Niveau van Default dat niet door gebruiker mag veranderd worden
SELECT(Niv,LimProd,DefKey,DefNiv,Titel) 
 New KKey,X,Y,Z,HKode,GKode,HKey,GKey,SKey,Mem,Tekst,Tekst2,Free,ExNiv
 Set Tekst=$S($P(^cLOG(boot,"DEV",$$IO^cQ5),"\")="MC":"PageUp",1:"SEL")
 Set FP=2101 Write @F,@F1
 Set Free=0 If Niv<0 Set Free=1,Niv=Niv*-1
 Set:$G(Titel)="" Titel="Klassificatie"
 Set Tekst2="" Set:Free Tekst2=", .[] indien nivo voldoende gespecifieerd"
 Set DefKey=$G(DefKey)
 Set DefNiv=$G(DefNiv)
 Set:'$L(DefKey)&'DefNiv DefKey=$G(sRef("KLAS"))
 Set LimProd=$G(LimProd)
 If DefKey Set KKey=DefKey If '$$DRN^DD("oPRKLK") Quit:DefNiv "" Set DefKey=""
 If DefNiv>0 Do  Goto SG:DefNiv=1,SS:DefNiv=2,PROD:DefNiv=3
 .Set (GKey,HKey,KKey,X)=DefKey
 .Set HKode=$$FF^DD("oPKKHKod")
 .Set GKode=$$FF^DD("oPKKGKod")
 .Set:$$FF^DD("oPKKNiv")>1 (HKey,X)=$$FF^DD("oPKKHKey")
 .Set:$$FF^DD("oPKKNiv")>2 (GKey,X)=$$FF^DD("oPKKGKey")
 .Set ExNiv=DefNiv
SH1 Set X="" Set:DefKey KKey=DefKey,X=$$FF^DD("oPKKHKod")
 Set ExNiv=1
 Do GETH
SH2 Set X=$$ASK^vhINP(Titel_" : ",2,X,"Ingave  klassificatie hoofdgroep",Tekst_" voor lijst van hoofgroepen"_Tekst2)
 If X="-" Goto EXIT
 If X="." Set:Free ExNiv=0 Goto EXIT
SH3 Set X=$$UPTRIMAN^vhRtn1(X)
 If X="" Do POPH Goto SH3:X=".",SG:"-"'[X Set:X="-" X="" Goto SH2
 If $D(Z(X)) Set X=$P(Z(X),D,3) Goto SG
 If $E($O(Z(X)),1,$L(X))=X Do POPH Goto SG:$L(X),SH2
 Goto SH2
SG Kill Y,Z
 Goto:Niv=1 EXIT
 Set (KKey,HKey)=X,HKode=$$FF^DD("oPKKHKod")
SG1 Set X="" If DefKey Set KKey=DefKey Set:$$FF^DD("oPKKHKey")=HKey X=$$FF^DD("oPKKGKod")
 Set ExNiv=2
 Do GETG
SG2
 Set X=$$ASK^vhINP(Titel_" : "_HKode_"-",3,X,"Ingave  klassificatie groep",Tekst_" voor lijst van groepen"_Tekst2)
 If X="-" Goto SH1:DefNiv<1,EXIT
 If X="." Set:Free X=HKey,ExNiv=1 Goto EXIT
SG3 Set X=$$UPTRIMAN^vhRtn1(X)
 If X="" Do POPG Goto SG3:X=".",SS:"-"'[X Set:X="-" X="" Goto SG2
 If $D(Z(X)) Set X=$P(Z(X),D,3) Goto SS
 If $E($O(Z(X)),1,$L(X))=X Do POPG Goto SS:$L(X),SG2
 Goto SG2
SS Kill Y,Z
 Goto:Niv=2 EXIT
 Set (KKey,GKey)=X,GKode=$$FF^DD("oPKKGKod")
SS1 Set X="" If DefKey Set KKey=DefKey Set:$$FF^DD("oPKKGKey")=GKey X=$$FF^DD("oPKKSKod")
 Set ExNiv=3
 Do GETS
SS2
 Set X=$$ASK^vhINP(Titel_" : "_HKode_"-"_GKode_"-",6,X,"Ingave  klassificatie subgroep",Tekst_" voor lijst van subgroepen"_Tekst2)
 If X="-" Goto SG1:DefNiv<2,EXIT
 If X="." Set:Free X=GKey,ExNiv=2 Goto EXIT
SS3 Set X=$$UPTRIMAN^vhRtn1(X)
 If X="" Do POPS Goto SS3:X=".",PROD:"-"'[X Set:X="-" X="" Goto SS2
 If $D(Z(X)) Set X=$P(Z(X),D,3) Goto PROD 
 If $E($O(Z(X)),1,$L(X))=X Do POPS Goto PROD:$L(X),SS2
 Goto SS2
PROD Kill Y,Z
 Goto:Niv=3 EXIT
 Set (SKey,KKey)=X,ExNiv=4
 Set PR=$$SELECT^PRODUKT6("KL",KKey)
 If PR="-" Goto SS1:DefNiv<3,EXIT
 If PR="." Set:Free X=SKey,ExNiv=3 Goto EXIT
 Set X=PR
EXIT Set FP=2101 Write @F,@F1
 Quit:X X_D_ExNiv
 Quit X
 
POPS Do POP(X,"Klassificatie subgroep van groep "_HKode_"-"_GKode)
 Quit
GETS New KKey,KSS,KHS,Mem,KGS
 Set KHS=$$GETSORT(HKey)
 Set (KGS,Mem,KSS)=$$GETSORT(GKey),Y(0)=0,Mem=$E(Mem,1,$L(Mem)-1)
 For  Set KSS=$$ORN^DD("oPRKLS") Quit:KSS=""!($E(KSS,1,$L(Mem))'=Mem)  Do
 .If LimProd,'$D(^KPH(KHS,KGS,KSS)) Quit
 .Set Y(0)=Y(0)+1,KKey=$$FF^DD("oPKSKey")
 .Set Y=$$FF^DD("oPKKSKod"),Y=Y_$J("",2-$L(Y))_" | "_$$FF^DD("oPKSOmsN")_D_KSS_D_KKey
 .Set Z($$UPTRIMAN^vhRtn1($$FF^DD("oPKKSKod")))=Y,Y(Y(0))=Y
 Quit
 
POPG Do POP(X,"Klassificatie groep van hoofdgroep "_HKode)
 Quit
GETG New KKey,KGS,KHS,Mem
 Set (KHS,Mem,KGS)=$$GETSORT(HKey),Y(0)=0,Mem=$E(Mem,1,$L(Mem)-1)
 For  Set KGS=$$ORN^DD("oPRKLG") Quit:KGS=""!($E(KGS,1,$L(Mem))'=Mem)  Do
 .If LimProd,'$D(^KPH(KHS,KGS)) Quit
 .Set Y(0)=Y(0)+1,KKey=$$FF^DD("oPKGKey")
 .Set Y=$$FF^DD("oPKKGKod"),Y=Y_$J("",2-$L(Y))_" | "_$$FF^DD("oPKGOmsN")_D_KGS_D_KKey
 .Set Z($$UPTRIMAN^vhRtn1($$FF^DD("oPKKGKod")))=Y,Y(Y(0))=Y
 Quit
 
POPH Do POP(X,"Klassificatie Hoofdgroep")
 Quit
GETH New KKey,KHS
 Set KHS="",Y(0)=0
 For  Set KHS=$$ORN^DD("oPRKLH") Quit:KHS=""  Do
 .If LimProd,'$D(^KPH(KHS)) Quit
 .Set Y(0)=Y(0)+1,KKey=$$FF^DD("oPKHKey"),Y=$$FF^DD("oPKKHKod")
 .Set Y=Y_$J("",2-$L(Y))_" | "_$$FF^DD("oPKHOmsN")_D_KHS_D_KKey
 .Set Z($$UPTRIMAN^vhRtn1($$FF^DD("oPKKHKod")))=Y,Y(Y(0))=Y
 Quit
 
POP(BeginL,Titel) 
 If $L(BeginL) New Y Do
 .Set Y(0)=0,X=BeginL
 .For  Set X=$O(Z(X)) Quit:X=""!($E(X,1,$L(BeginL))'=BeginL)  Set Y(0)=Y(0)+1,Y(Y(0))=Z(X)
 Set Y="22\B\"_Titel,X=""
 Do ^POP
 Set:X X=$P(Y(X),D,3)
 Set FP=2101 Write @F,@F1
 Quit
 
 ; --- Externe hulp routines ----
 
SORTKEY(KHNr,HG,KGNr,GR,KSNr,SG) 
 New R
 S R=$TR($J(KHNr,2)," ","0")
 S R=R_HG_$J("",2-$L(HG))
 Quit:'$D(KGNr) R_" "
 S R=R_$TR($J(KGNr,2)," ","0")
 S R=R_GR_$J("",3-$L(GR))
 Quit:'$D(KSNr) R_" "
 S R=R_$TR($J(KSNr,2)," ","0")
 S R=R_SG_$J("",6-$L(SG))
 Quit R_" "
GETSORT(KKey,TNiv)  
 New Niv,R
 S Niv=$$FF^DD("oPKKNiv")
 If $D(TNiv) Set:$G(TNiv)<Niv Niv=TNiv
 S R=$TR($J($$FF^DD("oPKKHNr"),2)," ","0")
 S R=R_$$FF^DD("oPKKHKod")_$J("",2-$L($$FF^DD("oPKKHKod")))
 Quit:Niv=1 R_" "
 S R=R_$TR($J($$FF^DD("oPKKGNr"),2)," ","0")
 S R=R_$$FF^DD("oPKKGKod")_$J("",3-$L($$FF^DD("oPKKGKod")))
 Quit:Niv=2 R_" "
 S R=R_$TR($J($$FF^DD("oPKKSNr"),2)," ","0")
 S R=R_$$FF^DD("oPKKSKod")_$J("",6-$L($$FF^DD("oPKKSKod")))
 Quit R_" "
  
GETSORTKEY(DispKey,Niv)
 New SortKey,Global,Exit
 Set Niv=$G(Niv)
 Set:Niv="" Niv=$L(DispKey,"-")
 Set:Niv>$L(DispKey,"-") Niv=$L(DispKey,"-")
 Set DispKey=$P(DispKey,"-",1,Niv)
 Set Global="^KP"_$P("HG\GR\SG",D,Niv)_"(SortKey)",SortKey=""
 For  Set SortKey=$O(@Global) Quit:SortKey=""  Do  Quit:$G(Exit)
 . Quit:$E(SortKey,3,4)'=$P(DispKey,"-")
 . Quit:$E(SortKey,7,9)'=$P(DispKey,"-",2)
 . Quit:$TR($E(SortKey,12,99)," ","")'=$TR($P(DispKey,"-",3),"/","")
 . Set Exit=1
 Quit SortKey
 
DISPLP(PRNr,MetOms) 
 New KKey
 Set KKey=$$KKEY(PRNr) Quit:KKey="" ""
 Quit $$DISPL(KKey,$G(MetOms))
 
DISPL(KKey,MetOms)  
 New Niv,R
 S Niv=$$GF^DD("oPKKNiv")
 Quit:'Niv ""
 S R=$$FF^DD("oPKKHKod")_$J("",2-$L($$FF^DD("oPKKHKod")))
 S:Niv>1 R=R_"-"_$$FF^DD("oPKKGKod")_$J("",3-$L($$FF^DD("oPKKGKod")))
 S:Niv>2 R=R_"-"_$$FF^DD("oPKKSKod")_$J("",6-$L($$FF^DD("oPKKSKod")))
 If $G(MetOms) Set R=R_" "_$$FF^DD("oPKKOmsN")
 Quit R
 
DISPLS(SortKey,MetOms) 
 New KHS,KGS,KSS,R
 Set R=""
 If $L(SortKey)>2 Set R=$E(SortKey,3,4)
 If $L(SortKey)>5 Set R=R_"-"_$E(SortKey,7,9)
 If $L(SortKey)>10 Set R=R_"-"_$E(SortKey,12,17)
 If $G(MetOms) Do
 .If $L(SortKey)>10 Set KSS=SortKey Set:$$DRN^DD("oPRKLS") R=R_" "_$$FF^DD("oPKSOmsN") Quit
 .If $L(SortKey)>5 Set KGS=SortKey Set:$$DRN^DD("oPRKLG") R=R_"  "_$$FF^DD("oPKGOmsN") Quit
 .If $L(SortKey)>2 Set KHS=SortKey Set:$$DRN^DD("oPRKLH") R=R_"  "_$$FF^DD("oPKHOmsN") Quit
 Quit R
 
GETKEY(SortKey) 
 New KHS,KGS,KSS
 Set (KHS,KGS,KSS)=$$UPTRIMAN^vhRtn1(SortKey)_" "
 If $L(KSS)>10 Set KSS=$P($G(^KPSG(KSS)),D,2) Quit:KSS="" "" Quit $$FF^DD("oPKSKey") 
 If $L(KGS)>5 Set KGS=$P($G(^KPGR(KGS)),D,2) Quit:KGS="" "" Quit $$FF^DD("oPKGKey") 
 If $L(KHS)>2 Set KHS=$P($G(^KPHG(KHS)),D,2) Quit:KHS="" "" Quit $$FF^DD("oPKHKey") 
 Quit ""
 
SPLITKEY(SortKey) 
 New KHNr,HG,KGNr,GR,KSNr,SG
 If $E(SortKey,$L(SortKey))=" " Set SortKey=$E(SortKey,1,$L(SortKey)-1)
 Set KHNr=$E(SortKey,1,2)
 Set HG=$E(SortKey,3,4)
 For  Quit:$E(HG,$L(HG))'=" "  Set HG=$E(HG,1,$L(HG)-1)
 Set KGNr=$E(SortKey,5,6)
 Set GR=$E(SortKey,7,9)
 For  Quit:$E(GR,$L(GR))'=" "  Set GR=$E(GR,1,$L(GR)-1)
 Set KSNr=$E(SortKey,10,11)
 Set SG=$E(SortKey,12,17)
 For  Quit:$E(SG,$L(SG))'=" "  Set SG=$E(SG,1,$L(SG)-1)
 If $L(KSNr) Quit +KHNr_","_HG_","_+KGNr_","_GR_","_+KSNr_","_SG
 If $L(KGNr) Quit +KHNr_","_HG_","_+KGNr_","_GR
 Quit +KHNr_","_HG
 
KKEY(PRNr) 
 New I,R,KKey
 Set KKey="",I=$O(^KPR(PRNr,"I"))
 Set:$E(I)="I" R=^KPR(PRNr,I),KKey=$P(R,D,4)
 Quit KKey
 
 ; Geeft een LB van alle KKeys tussen twee KKeys
GetKKeys(FromKKey,ToKKey)
 New D,KKeys,FromSortKey,ToSortKey,Niveau,Next,Rec,KKey,li
 Set D="\",FromKKey=$G(FromKKey),ToKKey=$G(ToKKey,FromKKey)
 ; Niveau bepalen via een der KKey's (HG, GR of SG)
 If FromKKey Set Niveau=$P(^KLAS("K",FromKKey),D)
 Else  If ToKKey Set Niveau=$P(^KLAS("K",ToKKey),D)
 Else  Set Niveau=1
 ; Indien niet gedefinieerd, ophalen van de KKey's volgens het niveau
 If 'FromKKey Set FromSortKey=$O(@("^KP"_$P("HG\GR\SG",D,Niveau)_"1("""")")),Rec=^(FromSortKey),FromKKey=$P(Rec,D,6)
 If 'ToKKey Set ToSortKey=$O(@("^KP"_$P("HG\GR\SG",D,Niveau)_"1("""")"),-1),Rec=^(ToSortKey),ToKKey=$P(Rec,D,6)
 ; Ophalen van de reeks van KKeys
 Set FromSortKey=$$GETSORT^KLASS(FromKKey),ToSortKey=$$GETSORT^KLASS(ToKKey)
 Set KKeys="",Next=$O(@("^KP"_$P("HG\GR\SG",D,Niveau)_"1("""_FromSortKey_""")"),-1)
 For  Set Next=$O(^(Next)) Quit:Next=""  Set Rec=^(Next),KKeys=KKeys_";"_$P(Rec,D,6) Quit:$P(Rec,D,6)=ToKKey
 Set $E(KKeys)="",KKeys=$$PiecesToList^vhLib(KKeys,";")
 If 0,Niveau=1 Do  ; Alle KKeys van een hoofdgroep
 . For li=1:1:$LL(KKeys) Do
 . . Set KKey=$LI(KKeys,li)
 . . Set (FromSortKey,ToSortKey)=$$GETSORT^KLASS(KKey)
 . . Set FromSortKey=$O(^KPGR1(FromSortKey)),Rec=^KPGR1(FromSortKey),FromKKey=$P(Rec,D,6)
 . . Set $E(ToSortKey,$L(ToSortKey))="Z"_$E(ToSortKey,$L(ToSortKey))
 . . Set ToSortKey=$O(^KPGR1(ToSortKey),-1),Rec=^KPGR1(ToSortKey),ToKKey=$P(Rec,D,6)
 . . Set $LI(KKeys,li)=$LB(KKey,$$GetKKeys(FromKKey,ToKKey))
 If 0,Niveau=2 Do  ; Alle KKeys van een groep
 . For li=1:1:$LL(KKeys) Do
 . . Set KKey=$LI(KKeys,li)
 . . Set (FromSortKey,ToSortKey)=$$GETSORT^KLASS(KKey)
 . . Set FromSortKey=$O(^KPSG1(FromSortKey)),Rec=^KPSG1(FromSortKey),FromKKey=$P(Rec,D,6)
 . . Set $E(ToSortKey,$L(ToSortKey))="Z"_$E(ToSortKey,$L(ToSortKey))
 . . Set ToSortKey=$O(^KPSG1(ToSortKey),-1),Rec=^KPSG1(ToSortKey),ToKKey=$P(Rec,D,6)
 . . Set $LI(KKeys,li)=$LB(KKey,$$GetKKeys(FromKKey,ToKKey))
 Quit KKeys