BLIMPIC ;Importeren van het BLUM DMS-PC Produkt Classificatie ^BLVD2; [ 03/16/95  10:56 AM ]
 Goto BEGIN
 ;
BEGIN ; 
 New %J
 Lock +BLKLAS:2 E  X ^cTXT(0,"N",46) G MENU
C1 ; Verwerking hoofding
 Set RecNaam="MSGB",RecInp=^BLImp(MsgId)
 Set RecHfd=$P(RecInp,"\",1)_D_$P(RecInp,"\",6)_D_$P(RecInp,"\",5)
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Set Once=0
 Set LEVNr=5005
 Set RecCnt=$P(RecInp,"\",8)
 Set RecNr=-1  
 ; Record 11
C2 Do NextRec Goto C6:RecNr=-1
KLAS G C2:RecType'=11 
 Set RecNaam="DMS-IC-11" DO TF
 Do KILL:'Once
 Goto C2:(Typ="")||(Key="")
 ; een bepaalde Typ || Key kan meerdere keren voorkomen afhankelijk van het aantal parents
 Set oKlas=##class(Blum.Klassificatie).%OpenId(Typ_"||"_Key)
 If '$isObject(oKlas) Do
 . Set oKlas=##class(Blum.Klassificatie).%New()
 . Set oKlas.Type=Typ
 . Set oKlas.Sleutel=Key 
 . Set oKlas.Omschrijving=Oms
 . Set oKlas.Potentieel=Potent
 . Set OK=oKlas.%Save()
 . ;Write OK
 Set:$L(Typ1)&&$L(Key1) MemParent(oKlas.%Id(),Typ1,Key1)=Faktor ; Onthouden link naar parent en factor 
 ; Record 12
 Do NextRec Goto C6:RecNr=-1
 Goto KLAS:RecType'=12
OMSCHR Set RecNaam="DMS-IC-12" Do TF
	Set oKlas.OmschrijvingLang=OmsLang
	Set OK=oKlas.%Save()
	Goto C2
C6 
	Do UPDATE
	Goto MENU
 
MENU
 	Lock -BLKLAS
 	Quit
 	
 ; Overbrengen van de onhouden subgroep en de onthouden parentlinks naar de klassificatie
UPDATE
	&sql(DECLARE UpdateKlas CURSOR FOR
		SELECT ID
    	INTO :ID
		FROM Blum.Klassificatie
    	)
 	&sql(OPEN UpdateKlas)
 	For  &sql(FETCH UpdateKlas) Quit:SQLCODE  Do 
 	. Quit:'$D(MemParent(ID))&&'$D(MemSubGrp(ID))
 	. Set oKlas=##class(Blum.Klassificatie).%OpenId(ID)
 	. ; De onthouden subgroep terug plaatsen
 	. If $D(MemSubGrp(ID)) Do
 	. . Do oKlas.SubGroepSetObjectId(MemSubGrp(ID))
 	. ; Verder aanvullen met links naar de parent 
 	. If $D(MemParent(ID)) Do
	. . Set (Typ1,Key1)=""
 	. . For  Set Typ1=$O(MemParent(ID,Typ1)) Quit:Typ1=""  Do
 	. . . For  Set Key1=$O(MemParent(ID,Typ1,Key1)) Quit:Key1=""  Do
 	. . . . Quit:'##class(Blum.Klassificatie).%ExistsId(Typ1_"||"_Key1)
 	. . . . Set oParentLink=##class(Blum.KlassificatieLink).%New()
 	. . . . Set oParentLink.Factor=MemParent(ID,Typ1,Key1)
 	. . . . Do oParentLink.ParentSetObjectId(Typ1_"||"_Key1)
 	. . . . Set OK=oKlas.Parents.SetAt(oParentLink,Typ1)
 	. . . .  ;W $$ParseStatus^vhLib(OK)
 	. . . . ;w "+"
 	. Set OK=oKlas.%Save()
	. ;W $$ParseStatus^vhLib(OK)
 	&sql(CLOSE UpdateKlas)
 	
 	; onhouden wanneer laatst upgedate en met welk bericht
 	Set ^Blum.KlassificatieD=RecHfd
	Quit
 
 
	; Verwijderen van de ganse klassificatie 
	; maar onthouden van de link naar de Van Hoecke klassificatie - subgroep
KILL 
	&sql(DECLARE RememberKlas CURSOR FOR
		SELECT ID,SubGroep
    	INTO :ID,:KlasSGKey
		FROM Blum.Klassificatie
    	WHERE Type='V2' and SubGroep is not null)
 	&sql(OPEN RememberKlas)
	Kill MemSubGrp,MemParent
 	For  &sql(FETCH RememberKlas) Quit:SQLCODE  Do 
 	. Quit:'$D(^KLAS("K",KlasSGKey)) ; bestaat niet in ^KLAS
 	. Set MemSubGrp(ID)=KlasSGKey
 	&sql(CLOSE RememberKlas)
	Do ##class(Blum.Klassificatie).%DeleteExtent()
 	Set Once=1
 	
 	;oude structuur overbrengen
 	;Set Key=""
 	;For  Set Key=$O(^BLVD2(Key)) Quit:Key=""  Do
 	. Set KlasSGKey=$P(^BLVD2(Key),D)
 	. Quit:KlasSGKey=""
 	. Quit:'$D(^KLAS("K",KlasSGKey)) ; bestaat niet in ^KLAS
 	. Quit:$D(MemSubGrp("V2||"_Key)) ; Reeds ingevuld door de nieuwe structuur
 	. Set MemSubGrp("V2||"_Key)=KlasSGKey
 	
	Quit
 
 ; Ophalen volgend record
NextRec Set RecNr=$N(^BLImp(MsgId,RecNr)) Q:RecNr=-1  Set RecInp=^(RecNr),RecType=$E(RecInp,2,3) Q
 ; Verwerken record
 
TF SET Tptr=0,Tptr=$N(^BLRecDef(LEVNr,RecNaam,Tptr)),R=""
TLoop Q:Tptr=-1
 Set TRec=^(Tptr),Piece=$P(TRec,D,4),Local=$P(TRec,D,5),Type=$P(TRec,D,6)
  If 'Piece&(Local="") Set Tptr=$N(^(Tptr)) Goto TLoop
 Set Mem=$E(RecInp,$P(TRec,D,1),$P(TRec,D,2))
LTRIM ;If $E(Mem,1)=" " Set Mem=$E(Mem,2,999) Goto LTRIM
RTRIM If $E(Mem,$L(Mem))=" " Set Mem=$E(Mem,1,$L(Mem)-1) Goto RTRIM
 Set:Type="N" Mem=+Mem ; Numeriek
 Set:Type="D"&(Mem="000000") Mem=""
 Set:Type="D"&($P(TRec,D,3)=6) Mem=$E(Mem,5,6)_"."_$E(Mem,3,4)_"."_$E(Mem,1,2) ; Datum 6 char
 Set:Type="D"&($P(TRec,D,3)=8) Mem=$E(Mem,7,8)_"."_$E(Mem,5,6)_"."_$E(Mem,1,4) ; Datum 8 char
 
 If Piece Set $P(R,D,Piece)=Mem
 If Local'="" Set @Local=Mem
 Set Tptr=$N(^(Tptr)) Goto TLoop
 
 ; Kill oude informatie
Kold Set XX=$N(^BLProd("D",IDNr,X)),XX=X
Kold1 Set XX=$N(^(XX)) If $E(XX,1)=X Kill ^(XX) Goto Kold1
 Q
 ;
 Q
Z X ^cZ Q
ZZ ; 10.06.91 - 10 u 17