BLIMPES ;BLUM Importeren van de externe specificatie [ 02/05/97  3:59 PM ]
 ; in het bestand ^BLProd("RPx";
 Goto BEGIN
 ;
BEGIN ; 
 New MailId,MailLnk,MailTxt
 L ^BLProd:2 E  X ^cTXT(0,"N",46) G MENU
C1 ; Verwerking hoofding
 Set RecNaam="MSGB",RecInp=^BLImp(MsgId)
 Set ^BLProd("RP")=$P(RecInp,"\",1)_D_$P(RecInp,"\",6)_D_$P(RecInp,"\",5)
 Set MailLnk=0
 Set MailTxt=1,MailTxt(1)="Nieuwe externe specificaties van Blum~"
 Set RecCnt=$P(RecInp,"\",8)
 Set RecNr=-1  
 ; Record 21
C2 Do NextRec Goto C6:RecNr=-1
 G C2:RecType'=21 
Klant Set RecNaam="DMS-ES-21" DO TF
 Set RTemp=R
 Kill ^BLProd("RP","ZXY")
 Merge ^BLProd("RP","ZXY")=^BLProd("RP",KLNr)
 Kill ^BLProd("RP",KLNr)
 Set ^BLProd("RP","ZXY")="Tijdelijk opslag van RP"
 Set ^BLProd("RP",KLNr)=+$H
 Set MailLnk=MailLnk+1,MailLnk(MailLnk)="BLPUTZ"_D_KLNr_D_"P"
 Set MailTxt=MailTxt+1,MailTxt(MailTxt)="~KLNr  "_$P($G(^BLBeri("K",KLNr),"Onbekend"),D)
 ; Record 31
 Do NextRec Goto C6:RecNr=-1
 Goto Klant:RecType'=31
Prod Set RecNaam="DMS-ES-31" Do TF
 Set $P(R,D,3)=$P(R,D,3)/100
 Set:GrtO=1 $P(R,D,1)=$P(R,D,1)*10
 Set $P(R,D,2)=$S(GrtO=3:"M",GrtO=2:"H",GrtO=1:"H",1:"E")
 Set Dat=$$INTDATE^vhLib.DataTypes($P(R,D,8),"DK") 
 Set:Dat<($H-(356*2)) Dat=""
 Set $P(R,D,8)=Dat
 If $D(^BLProd("RP","ZXY",IDNr)) Set $P(R,D,9)=$P(^BLProd("RP","ZXY",IDNr),D,9)
 Else  If $D(^BLProd("RPS",KLNr,IDNr)) Set $P(R,D,9)=$P(^BLProd("RPS",KLNr,IDNr),D,9)
 Set:'$D(^BLProd("RP",KLNr,IDNr)) ^BLProd("RP",KLNr,IDNr)=R
 ; Record 31 en volgende
C4 Do NextRec Goto C6:RecNr=-1
 Goto Klant:RecType=21,Prod:RecType=31
 Goto C4
C6 Goto MENU
MENU Set:$G(MailLnk) MailId=$$SYSTEM^vhMAIL("","",$P($T(+1),"["),"BLUMES",.MailTxt,.MailLnk,"","A")
 Kill ^BLProd("RP","ZXY")
 L  Q
 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(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=$E(Mem,7,8)_"."_$E(Mem,5,6)_"."_$E(Mem,3,4) ; 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",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