BURSTAT  ;Burbidge statistiek [ 08/16/2002  2:52 PM ]
 Do INIT^vhTERMINA
 Kill ^HULP($J)
 Set Max=9999999999
 Set FakNr=""
 Set Begin=$$CALCDATE^vhDTyp($H,"M",-12,"MD")
 Set Cnt=0
 For  Set FakNr=$O(^KFA("F",FakNr)) Quit:FakNr=""  Do  Quit:Cnt>Max
 .Set KLNr=$P(^KFA("F",FakNr,0,0),D)
 .Set Datum=$$CALCDATE^vhDTyp($$INTDATE^vhDTyp($P(^KFA("F",FakNr,0,0),D,6),"DK"),"M","MD")
 .Quit:Datum<Begin
 .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,"J5810")),'$D(^KPRO(PRNr,"J5810")) Quit
 ...Set Key=$O(^KPR(PRNr,"I"))
 ...If $E(Key)="I",$P(^KPR(PRNr,Key),D,3)["STA" Quit
 ...Set Cnt=Cnt+1
 ...Set Datums(Datum)=""
 ...Set KLRec=$G(^HULP($J,KLNr))
 ...Set MndRec=$G(^HULP($J,KLNr,Datum))
 ...Set $P(KLRec,D)=$P(KLRec,D)+$P(Rec,D,34)
 ...Set Piece=$S($P(Rec,D,3)<0:2,1:1)
 ...Set $P(MndRec,D,Piece)=$P(MndRec,D,Piece)+$P(Rec,D,3)
 ...Set ^HULP($J,KLNr)=KLRec
 ...Set ^HULP($J,KLNr,Datum)=MndRec
 zw Cnt
 ; Proforma
 Set FakNr=""
 Set Cnt=0
 For  Set FakNr=$O(^KFAP("F",FakNr)) Quit:FakNr=""  Do  Quit:Cnt>Max
 .Set KLNr=$P(^KFAP("F",FakNr,0,0),D)
 .Set Datum=$$CALCDATE^vhDTyp($$INTDATE^vhDTyp($P(^KFAP("F",FakNr,0,0),D,6),"DK"),"M","MD")
 .Quit:Datum<Begin
 .Set ULNr="U"
 .For  Set ULNr=$O(^KFAP("F",FakNr,ULNr)) Quit:ULNr=""  Do
 ..Set LNr=99
 ..For  Set LNr=$O(^KFAP("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,"J5810")),'$D(^KPRO(PRNr,"J5810")) Quit
 ...Set Key=$O(^KPR(PRNr,"I"))
 ...If $E(Key)="I",$P(^KPR(PRNr,Key),D,3)["STA" Quit
 ...Set Cnt=Cnt+1
 ...Set Datums(Datum)=""
 ...Set KLRec=$G(^HULP($J,KLNr))
 ...Set MndRec=$G(^HULP($J,KLNr,Datum))
 ...Set $P(KLRec,D,2)=$P(KLRec,D,2)+$P(Rec,D,34)
 ...Set Piece=$S($P(Rec,D,3)<0:4,1:3)
 ...Set $P(MndRec,D,Piece)=$P(MndRec,D,Piece)+$P(Rec,D,3)
 ...Set ^HULP($J,KLNr)=KLRec
 ...Set ^HULP($J,KLNr,Datum)=MndRec
 zw Cnt
TRANS ; Transfert
 READ !,"Transfert",K
 Write "KLNr",$C(9),"Naam",$C(9),"Regio"
 Set Mnd=""
 For  Set Mnd=$O(Datums(Mnd))  Quit:Mnd=""  Do
 .Set MndE=$$EXTDATE^vhDTyp(Mnd,"DM")
 .Write $C(9),MndE,$C(9),$C(9),$C(9)
 Write $C(9),"BurbFak",$C(9),"BurbProf",$C(9),"Tot",!
 Set KLNr=""
 For   Set KLNr=$O(^HULP($J,KLNr))  Quit:KLNr=""  Do
 .Set KLRec=^KKL(^KK1(KLNr),0)
 .Write KLNr,$C(9),$P(KLRec,D,2),$C(9),$P(KLRec,D,20)
 .Set Mnd=""
 .For  Set Mnd=$O(Datums(Mnd))  Quit:Mnd=""  Do
 ..Set Rec=$G(^HULP($J,KLNr,Mnd))
 ..Write $C(9),$P(Rec,D,1),$C(9),$P(Rec,D,2),$C(9),$P(Rec,D,3),$C(9),$P(Rec,D,4)
 .Write $C(9),$TR($P(^HULP($J,KLNr),D),".",",")
 .Write $C(9),$P(^HULP($J,KLNr),D,2)
 .Write $C(9),$TR($P($G(^KKAAP(KLNr,0,0,0,0)),D),".",","),!
 Write "~~~"