BLIMPPR ;Importeren van het BLUM produktenbestand (BLProd) uit het Import bestand;BLIMPPR; [ 02/24/2001  11:07 AM ]
 Goto BEGIN
 ;
BEGIN ; 
 N MsgRec,BLOld,LogNewProd
 L ^BLProd:1 E  Do LDISP^vhLock($NA(^BLProd)) G MENU
C1 ; Verwerking hoofding
 Set LEVNr=5005
 Set RecNaam="MSGB",(RecInp,MsgRec)=^BLImp(MsgId)
 Set ^BLProd=$P(RecInp,"\",1)_D_$P(RecInp,"\",6)_D_$P(RecInp,"\",5)
 Set PrijsLijst=""
 Set RecCnt=$P(RecInp,"\",8)
 Set UpDate=$TR($P(RecInp,"\",6),"-","."),RecNr=-1
 ; Record 21
C2a Do NextRec Goto C6:RecNr=-1
 G C2a:RecType'=11
 Set PrijsLijst="" 
 Set RecNaam="DMS-PR-11" Do TF
 Set PrijsLijst="E"_+PrijsLijst
 If PrijsLijst="" Goto C2a
 Set PrijsLijst=$S(+PrijsLijst=43:"K",1:"E")_+PrijsLijst
C2b Do NextRec Goto C6:RecNr=-1
 G C2b:RecType'=21 
Prod Set RecNaam="DMS-PR-21",(SetNr,ComNr,LanNr)=1 Do TF,TC
 Set RTemp=R
 ; Record 22
 Do NextRec Goto C6:RecNr=-1
 Goto Prod:RecType'=22
 Set RecNaam="DMS-PR-22" Do TF
 Set KortTek=$P(RTemp,D,1)
 Kill BLOld,LogNewProd
 If $D(^BLProd("D",PRIDNO)) Do
 . Set KortTek=$P(^(PRIDNO),D,1),ModProd(PRIDNO)=MsgRec  ; om een mail te versturen zie ^BLVWIMP
 . Merge BLOld=^BLProd("D",PRIDNO)
 Else  Set NewProd(PRIDNO)=MsgRec,LogNewProd=1
 Set:$TR(PREANN,"0","")="" PREANN=""
 Set BLRec=RTemp
 Set $P(BLRec,D,16)="" ; clear for Transmission of DMS-OC
 Set $P(BLRec,D,8)=PRPROG
 Set $P(BLRec,D,17)=UpDate
 Set $P(BLRec,D,18)=PRQSUNN
 Set $P(BLRec,D,19)=PRCLAS
 Set $P(BLRec,D,20)=PREANN
 Set $P(BLRec,D,21)=PRMUTS
 Set $P(BLRec,D,22)=$S(+PRMFAK:+PRMFAK,1:"")
 Set $P(BLRec,D,23)=$S(+PRDMLGA:+PRDMLGA,1:"")
 Set $P(BLRec,D,24)=$S(+PRDMBRA:+PRDMBRA,1:"")
 Set $P(BLRec,D,25)=$S(+PRDMHOA:+PRDMHOA,1:"")
 Set $P(BLRec,D,9)=PRWGHT*$S(PRWGDI=0:1000,PRWGDI=1:100,PRWGDI=2:10,1:1)
 Set $P(BLRec,D,26)=PRWNET*$S(PRWGDI=0:1000,PRWGDI=1:100,PRWGDI=2:10,1:1)
 Set $P(BLRec,D,27)=PRTARA*$S(PRWGDI=0:1000,PRWGDI=1:100,PRWGDI=2:10,1:1)
 Set $P(BLRec,D,28)=PRGFO
 Set $P(BLRec,D,29)=PRVOLUB
 Set $P(BLRec,D,30)=PRVDIM
 ; Prijs record
 Set PrijsRec=""
 ;Set $P(PrijsRec,D,1)=PRNEPR*$S(PRPRDI=1:10,1:0) ; Indien per tiental dan omvormen naar per honderd
 ;Set $P(PrijsRec,D,3)=$S(PRPRDI=3:"M",PRPRDI=2:"H",PRPRDI=1:"H",1:"E")
 Set $P(PrijsRec,D,6)=PRMINQ
 Set ^BLProd("D",PRIDNO)=BLRec
 Set ^BLProd("D",PRIDNO,"PPL",PrijsLijst)=PrijsRec
 Set ^BLProd("I",SPRSHDS_D_PRIDNO)=""
 Set:RecCnt<500 ^BLProd("N",PRIDNO)=""
 Do LOG(PRIDNO,.BLOld,$S($G(LogNewProd):"N",1:"H"))
 ; Aanpassen van in het VH-producten bestand
 Do CopyBlumID^BLPROD(PRIDNO)
 ;
 If $S(RecNr<500:'(RecNr#10),1:'(RecNr#20)) Set FP=2403 Write @F,PRIDNO,"   ",$P(RTemp,D,1),@F2
 If KortTek'=$P(RTemp,D,1) Set PRSHDS=KortTek Do TC Kill ^(SPRSHDS_D_PRIDNO)
 ; Record 23 en volgende
C4 Do NextRec
 Goto C6:RecNr=-1
 Goto Prod:RecType=21
 Do Rec23:RecType=23,Rec24:RecType=24,Rec26:RecType=26,Rec29:RecType=29
 Goto C4
 ; Record 23
Rec23 Set RecNaam="DMS-PR-23" Do TF I LanNr=1 S X="B" D Kold
 Set ^BLProd("D",PRIDNO,"B"_PRLANC_LanNr)=R,LanNr=LanNr+1
 Do:'$G(LogNewProd) LOG(PRIDNO,.BLOld,"B")
 Q
 ; Record 24
Rec24 Set RecNaam="DMS-PR-24" Do TF I SetNr=1 S X="S" D Kold
C5 If $L($P(R,D,1)),$P(R,D,1)'="""" Set ^BLProd("D",PRIDNO,"S"_SetNr)=$P(R,D,1,2),R=$P(R,D,3,99),SetNr=SetNr+1 G C5
 Do:'$G(LogNewProd) LOG(PRIDNO,.BLOld,"S")
 Q
 ; Record 26
Rec26 New PRGRPR,PRNEPR,PRPRDI,ValDate,PRDISG
 Set RecNaam="DMS-PR-26" Do TF
 Set:PRPRDI=1 PRGRPR=PRGRPR*10,PRNEPR=PRNEPR*10
 Set PRPRDI=$S(PRPRDI=3:"M",PRPRDI=2:"H",PRPRDI=1:"H",1:"E")
 Set PrijsRec=$G(^BLProd("D",PRIDNO,"PPL",PrijsLijst))
 Set $P(PrijsRec,D,1)=PRGRPR
 Set $P(PrijsRec,D,2)=PRNEPR
 Set $P(PrijsRec,D,3)=PRPRDI
 ;w ValDate r k
 Set $P(PrijsRec,D,5)=$$INTDATE^vhLib.DataTypes(ValDate)
 Set $P(PrijsRec,D,4)=PRDISG
 Set ^BLProd("D",PRIDNO,"PPL",PrijsLijst)=PrijsRec
 Do:'$G(LogNewProd) LOG(PRIDNO,.BLOld,"P")
 Q
 ; Record 29
Rec29 Set RecNaam="X9" Do TF I ComNr=1 S X="O" D Kold
 Set ^BLProd("D",PRIDNO,"O"_ComNr)=R,ComNr=ComNr+1
 Do:'$G(LogNewProd) LOG(PRIDNO,.BLOld,"O")
 Q
 
 ; Verwijderen niet gewijzigde indien complete update
C6 Goto MENU ;verwijderen is kortgesloten;:MINETC'="C" Set PRIDNO=-1
C7 Set PRIDNO=$N(^BLProd("D",PRIDNO)) Goto MENU:PRIDNO=-1
 Set R=^(PRIDNO) Goto C7:$P(R,D,17)=UpDate
 Set PRSHDS=$P(R,D,1) Do TC
 Kill ^(PRIDNO),^BLProd("I",SPRSHDS_D_PRIDNO) Goto C7
MENU L  Q
 ; 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
 ; Compressing korttekst
TC S I=0,SPRSHDS=""
TC1 S I=I+1 I I'>$L(PRSHDS) S Y=$E(PRSHDS,I) S:Y'?1P SPRSHDS=SPRSHDS_Y G TC1
 Q
 ; Kill oude informatie
Kold Set XX=$N(^BLProd("D",PRIDNO,X)),XX=X
Kold1 Set XX=$N(^(XX)) If $E(XX,1)=X Kill ^(XX) Goto Kold1
 Q
 ;
 ; Logging van de gewijzigde data
 ; LogType	'H' = Hoffdnode
 ; 			'P' = Prijszetting
 ; 			'B' = Beschrijving
 ; 			'O' = Omschrijving
LOG(BLID,BLOld,LogType)
 New B,I,T,R,Taal,BLNew,P1,P16,BDOld,BDNew,BEOld,BENew,BFOld,BFNew,ONew,OOld,ID
 If $G(QU)="" New QU Set QU="SYS"
 Set LogType=$G(LogType,"HBSPO")
 If LogType'="N" Do
 . Merge BLNew=^BLProd("D",BLID)
 . Set ID=BLID,(Old,New,BDOld,BDNew,BEOld,BENew,BFOld,BFNew,ONew,OOld)=""
 . ; Log van de gewijzigde hoofdnode
 . If LogType["H" For T=401:1 Set R=$T(@("T"_T_"^Blum.RaadplegenProduct")) Quit:R=""  Do
 . . Set R=$P(R,";",2,99),P1=$P(R,";"),P8=$P(R,";",8),P9=$P(R,";",9),P13=$P(R,";",13),P16=$P(R,";",16)
 . . Set Old=$P(BLOld,D,P16#100),New=$P(BLNew,D,P16#100)
 . . Xecute:$L(P8) "Set K=Old,B(1)=BLOld,U3="_P8_" Set Old=U3,K=New,B(1)=BLNew,U3="_P8_" Set New=U3"
 . . Set Old=$E(Old,1,P9+P13),New=$E(New,1,P9+P13)
 . . Quit:Old=New
 . . Do DLOGMOD^LOG("BLProd",ID,P16,Old,New,P1)
 . ;
 . ; Log van de gewijzigde prijszetting
 . If LogType["P" For T=501:1 Set R=$T(@("T"_T_"^Blum.RaadplegenProduct")) Quit:R=""  Do
 . . Set R=$P(R,";",2,99),P1=$P(R,";"),P8=$P(R,";",8),P9=$P(R,";",9),P13=$P(R,";",13),P16=$P(R,";",16)
 . . If $E(P16,1,3)="PPL" Set Old=$G(BLOld("PPL",$P(P16,"PPL",2))),New=$G(BLNew("PPL",$P(P16,"PPL",2)))
 . . Else  Set Old=$P(BLOld,D,P16#100),New=$P(BLNew,D,P16#100)
 . . Xecute:$L(P8) "Set K=Old,B(1)=Old,U3="_P8_" Set Old=U3,K=New,B(1)=New,U3="_P8_" Set New=U3"
 . . Set Old=$E(Old,1,P9+P13),New=$E(New,1,P9+P13)
 . . Quit:Old=New
 . . Do DLOGMOD^LOG("BLProd",ID,P16,Old,New,P1)
 . ;
 . ; Log van de gewijzigde beschrijving
 . If LogType["B" Do
 . . For Taal="D","E","F" For I=1:1:15 Do
 . . . Set R=$G(BLOld("B"_Taal_I))
 . . . Set:$L(R) @("B"_Taal_"Old")=@("B"_Taal_"Old")_", "_R
 . . . Set R=$G(BLNew("B"_Taal_I))
 . . . Set:$L(R) @("B"_Taal_"New")=@("B"_Taal_"New")_", "_R
 . . For Taal="D","E","F" Do
 . . . Set $E(@("B"_Taal_"Old"),1,2)=""
 . . . Set $E(@("B"_Taal_"New"),1,2)=""
 . . . Quit:@("B"_Taal_"Old")=@("B"_Taal_"New")
 . . . Do DLOGMOD^LOG("BLProd",ID,"",@("B"_Taal_"Old"),@("B"_Taal_"New"),"Beschr "_$S(Taal="D":"duits",Taal="E":"engels",Taal="F":"frans",1:"nederlands"))
 . ;
 . ; Log van de gewijzigde opmerking
 . If LogType["O" Do
 . . For I=1:1:15 Do
 . . . Set R=$G(BLOld("O"_I))
 . . . Set:$L(R) OOld=OOld_", "_R
 . . . Set R=$G(BLNew("O"_I))
 . . . Set:$L(R) ONew=ONew_", "_R
 . . Set $E(OOld,1,2)=""
 . . Set $E(ONew,1,2)=""
 . . Do:OOld'=ONew DLOGMOD^LOG("BLProd",ID,"",OOld,ONew,"Opmerking")
 Else  Do DLOGNEW^LOG("BLProd",PRIDNO)
 Quit
 ;