BURBVKP  ;Burbidge verkopen [ 04/03/2003  9:29 AM ]
 Do INIT^vhTERMINA
 Kill ^HULP($J)
 Set FakNr="700000"
 Set LevNr=$$SELECT^LEVER()
 Set Begin=$$CALCDATE^vhDTyp($H,"M",-11,"FD")
 Set Dev=$$OPEN^vhDEV($$DIRUSER^vhDEV,$$ASKFILE^vhDEV("TRANSFERT.TXT"),"W")
 Quit:0[Dev
 Use Dev
 Write $TR("Datum,Korttekst,Klas,Reeks,Kleur,Typ,Afmeting,Sort,Aantal,AKP,VKP",",",$C(9)),!
 For  Set FakNr=$O(^KFA("F",FakNr)) Quit:FakNr=""  Do 
 .Set Datum=$$INTDATE^vhDTyp($P(^KFA("F",FakNr,0,0),D,6),"DK")
 .Quit:Datum<Begin
 .Set Datum=$P(^KFA("F",FakNr,0,0),D,6)
 .Set ULNr="U"
 .For  Set ULNr=$O(^KFA("F",FakNr,ULNr)) Quit:ULNr=""  Do
 ..Set LNr=99
 ..For  Set LNr=$O(^KFA("F",FakNr,ULNr,LNr)) Quit:LNr=""  Do
 ...Set Rec=^(LNr)
 ...Quit:'$P(Rec,D,2)
 ...Quit:$P(Rec,D,17)'="KF6"
 ...Set PRNr=$P(Rec,D,2)
 ...If $D(^KPR(PRNr,"J"_LevNr)) Do
 ....Set Rec0=^KPR(PRNr,0)
 ....Set Rec1=^KPR(PRNr,1)
 ....Set Rec2=^KPR(PRNr,2)
 ....Set RecI="",Key=$O(^KPR(PRNr,"I"))
 ....Set:$E(Key)="I" RecI=^KPR(PRNr,Key)
 ...Else  If $D(^KPRO(PRNr,"J"_LevNr)) Do
 ....Set Rec0=^KPRO(PRNr,0)
 ....Set Rec1=^KPRO(PRNr,1)
 ....Set Rec2=^KPRO(PRNr,2)
 ....Set RecI="",Key=$O(^KPRO(PRNr,"I"))
 ....Set:$E(Key)="I" RecI=^KPRO(PRNr,Key)
 ...Else  Quit  ; Geen burbidge produkt
 ...Set SG=$E($P(RecI,D,3),12,14)
 ...; Geen deur accessoire
 ...If LevNr=6092 Quit:SG="600"  Quit:SG="700"
 ...If LevNr=6428 Quit:SG="600"  Quit:SG="700"
 ...If LevNr=5810 Quit:SG="G&K"  Quit:SG="600"  Quit:SG="700"  Quit:SG="881"
 ...If $P(RecI,D,3)["STA" Quit  ;Geen staander
 ...Set Reeks=$E($P(Rec0,D,1),2,5-($E($P(Rec0,D,1),5)="."))
 ...Set Kleur=$E($P(Rec0,D,1),6,7)
 ...Set Type=$E($P(Rec0,D,1),9,11)
 ...Set Type=$$UPTRIMAN^vhRtn1(Type)
 ...Set:$L(Type)=1 Type="0"_Type
 ...Set Afm=""
 ...;Set Afm=$G(^BURBID("EXPORT","XXX",Type))
 ...Set VolgNr=$P(Afm,D)
 ...Set Afm=$P(Afm,D,4)
 ...Write $TR(Datum,".","/"),$C(9),$P(Rec0,D,1),$C(9),SG,$C(9),Reeks,$C(9),Kleur,$C(9),"="""_Type_"""",$C(9),Afm,$C(9),VolgNr,$C(9),$P(Rec,D,3),$C(9),$TR($P(Rec,D,33),".",","),$C(9),$TR($P(Rec,D,34),".",","),!
 Close Dev