BLIMPEP ;Importeren van het BLUM extended produkten info uit het Import bestand [ 09/24/2002  1:32 PM ]
 Goto BEGIN
 ;
BEGIN ; 
 L ^BLProd:2 E  X ^cTXT(0,"N",46) G MENU
 New RecType,RecNaam,LineRef,R,RecCnt,RecCnt,UpDate
C1 ; Verwerking hoofding
 Set RecNaam="MSGB",RecInp=^BLImp(MsgId)
 Set ^BLProd=$P(RecInp,"\",1)_D_$P(RecInp,"\",6)_D_$P(RecInp,"\",5)
 
 Set RecCnt=$P(RecInp,"\",8)
 Set UpDate=$TR($P(RecInp,"\",6),"-","."),RecNr=-1
 ; Record 21
C2 Do NextRec Goto C6:RecNr=-1
 G C2:RecType'=21 
Prod Set RecNaam="DMS-EP-21",(SetNr,ComNr,LanNr)=1 Do TF
 Goto C2:'$L($G(PRIDNO))
 Goto C2:'$D(^BLProd("D",PRIDNO))
 Set FP=2401 Write @F,@F2,PRIDNO
 Kill ^BLPrTxt("O",PRIDNO,PRSPRACH)
 Set ^BLPrTxt("O",PRIDNO,PRSPRACH)=R
 ; Record 22
C3 Do NextRec Goto C6:RecNr=-1
 Goto Prod:RecType=21
 Goto C2:RecType'=22
 Set RecNaam="DMS-EP-22" Do TF
 Set LineRef=+((PRLINO)_$E(100+PRSULI,2,3))
 Set R=$TR(R,$C(132,129,148,225),"δόφί")
 Set ^BLPrTxt("O",PRIDNO,PRSPRACH,LineRef)=R
 Goto C3
 ; 
C6 Goto MENU ;verwijderen is kortgesloten;:MINETC'="C" Set PRIDNO=-1
 
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(5005,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"&(Mem'="") Mem=$E(Mem,5,6)_"."_$E(Mem,3,4)_"."_$E(Mem,1,2) ; Datum
 
 If Piece Set $P(R,D,Piece)=Mem
 If Local'="" Set @Local=Mem
 Set Tptr=$N(^(Tptr)) Goto TLoop
 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
 ;
 Q
Z X ^cZ Q
ZZ ; 10.06.91 - 10 u 17