BLIMP G VERWERK ;Importeren van het BLUM bestand naar BLImp bestand; [ 11/29/2003   8:10 AM ]
 ;
VERWERK New Dir,File
 Write @F11,@F1,@FMTI," VAN HOECKE : Importeren van BLUM bestand ",@FMTi
 Set FP=2201 Write @F,@F1,"Ingave het te importeren bestand"
 
 Set Dir=^BLBeri("MSMGATEWAY")_"\EDI_IN\"
 Set File=$$DISPDIR^vhDEV(Dir,"*.*")
 Quit:File=""
 Do CONVERT(Dir,File)
 
 ; Verwijderen van oude archives
 Do SCANDIR^vhDEV(^BLBeri("MSMGATEWAY")_"\EDI_IN\ARCHIVE\","*.*",$NA(Local),"X",30)
 
 D ^cA604,INIT^vhTERMINA
 Do ^BLVWIMP ; Verdergaan met verwerking van lijst
 Quit
 
SCANONLINE ; verwerken van alle EDI bestanden opgeroepen van BLVWIMP
 Set Dir=^BLBeri("MSMGATEWAY")_"\EDI_IN\"
 Set File=$$DISPDIR^vhDEV(Dir,"*.*")
 Quit:File=""
 Do CONVERT(Dir,File)
 Quit
 
SCAN ; Achtergrond job dat alle EDI-bestanden verwerkt 
 New Dir,File
 S Q="K" D ^cA604
 Set Dir=^BLBeri("MSMGATEWAY")_"\EDI_IN\"
 Do SCANDIR^vhDEV(Dir,"*.*",$NA(Local)) 
 Set File=""
 For  Set File=$O(Local(File)) Quit:File=""  Do
 . Do CONVERT(Dir,File,1) ; verwerken
 ;Verwijder oude archives
 Do SCANDIR^vhDEV(Dir_"ARCHIVE\","*.*",$NA(Local),"X",30)
 Kill Local
 Do SCANDIR^vhDEV(Dir,"*.*",$NA(Local)) 
 If $L($O(Local(""))) Do  ; Na het verwerken zijn er nog bestanden 
 . Do WARN^vhTXTPOP("Er zijn nog bestanden niet verwerkt "_Dir,,1)
 Quit
 
CONVERT(Dir,File,Muet) 
 New Local,MsgNr,Skip
 Set Muet=$G(Muet)
 Set MsgNr=""
 Set Skip=0
 ; Inlezen bestand via callback
 Set File=$$READ^vhDEV(Dir,File,"D`LINE^"_$ZN,"M")
 If MsgNr Do ERREND
 ; Verplaatsen naar archive
 Set:$L(File) Status=$$MOVEFILE^vhDEV(Dir,File,Dir_"ARCHIVE\")
 
 Quit
 
LINE(Inp)  ; Callback vanuit READ^vhDEV
 Quit:Skip
 Set Inp=$TR(Inp,$C(10),"") ; verwijder linefeed
 If $F(Inp,"##TRUB")'=0 ; Transmissie begin
 Else  If $F(Inp,"##TRUE")'=0 ; Transmissie einde
 Else  If $F(Inp,"##MSGB")'=0 Do  ; Message begin
 . Do NEWMSG(Inp) 
 . If 'Muet Set FP=2301 W @F,@F1,@FCH,"Record ingelezen : " 
 Else  If $F(Inp,"##MSGE")'=0 Do  ; Message einde
 . Do ENDMSG(Inp) Quit
 Else  Do  ;Data verwerken
 . Do DATA(Inp)
 . If 'Muet,$S(RecNr<500:'(RecNr#10),1:'(RecNr#100)) Set FP=2320 W @F,$J(RecNr,6) 
 Quit
 
DATA(Inp) Quit:'MsgNr ; Als MSGB nog niet verwerkt is
 Set RecNr=RecNr+1
 Set ^BLImp(MsgNr,RecNr)=Inp
 Quit
 
NEWMSG(Inp) ;Start van een nieuw bericht
 Set RecNr=0
 If MsgNr Do ERREND
 Set RecInp=Inp
 Set LevNr=$S($E(Inp,7,9)="BUR":5810,1:5005) ; Invullen leverancier
 Set RecNaam="MSGB"
 Do TF
 Set $P(R,D,2)=LevNr
 Set MsgId=$P(R,D,1)
 
 If $D(^BLBeri("B",MsgId)) Do  ; controle de oude log van het bericht mag verwijderd worden
 . Set Dat=$$INTDATE^vhDTyp($P(^BLBeri("B",MsgId),D,3),"DK")
 . Set:'Dat Dat=$$INTDATE^vhDTyp($P(^BLBeri("B",MsgId),D,5),"DK")
 . If Dat<($H-100) Kill ^BLBeri("B",MsgId) ; indien ouder dan honderd dagen
 
 Set Import=1
 If $D(^BLBeri("B",MsgId))||$D(^BLBeri("T",MsgId)) Do  ; bestaat nog steeds dus recent bericht
 . If Muet Do
 . . Do WARN^vhTXTPOP("Bericht "_MsgId_" is reeds ingelezen",,Muet)
 . . Set Import=""
 . Else  Do
 . . Set Import=$$^vhTXTPOP("BLIMP","REDO",,$P(R,D,3)_"-"_$P(R,D,4),MsgId,$P(R,D,6))
 
 If Import Do
 . Set MsgNr=+$O(^BLImp(MsgNr),-1)+1
 . Kill ^BLImp(MsgNr)
 . Set ^BLImp(MsgNr)=R
 Else  Do 
 . Set MsgNr=""	 
 Quit
 
ENDMSG(Inp)  ; Einde van een bericht
 Quit:'MsgNr
 Set R=^BLImp(MsgNr)
 Set MsgNr=""
 Set T=$S($P(R,D,11):"T",1:"B") ; Opslaan in BLBeri
 Quit:$P(R,D,3)="COM"  ; Indien COM bericht dan niet opslaan, dit kan normaal niet voorkomen.
 ; Opslaan van bericht voor bericht bevestiging
 Set ^BLBeri(T,$P(R,D,1))=$P(R,D,3)_D_$P(R,D,4)_D_$P(R,D,6)_D_$P(R,D,7)_D_DT_D_$P(R,D,11)_D_$P(R,D,8)_D_D_$P(R,D,2)
 Q
 
ERREND ; Fout in het afsluiten van een bericht
 Do WARN^vhTXTPOP("Import bestand "_File_" is niet behoorlijk afgesloten",,Muet)
 Set Skip=1
 Quit
 
 ;Transformeer BLUM record naar Mumps record
 ;Parameters 
 ;RecNaam : Naam van het record
 ;RecInp : Geimporteerde 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
 Set:Type="D" Mem=$E(Mem,5,6)_"-"_$E(Mem,3,4)_"-"_$E(Mem,1,2)
 Set:Piece $P(R,D,Piece)=Mem
 Set:Local'="" @Local=Mem
 Set Tptr=$N(^(Tptr)) Goto TLoop