PVBulo ; Rechtzetting credits BULO [ 05/19/99  1:16 PM ]
 K  d INIT^vhTERMINA
 Set Scrn=5
 for j=1:1:Scrn Do
 .Write @F11,@F1
 .Write sScr("PAGE")
 .for i=1:1:23 do
 ..w !,"Dit is test voor pagina ",j," lijn ",i
 .Do STORE^vhTERMINA()
 for j=1:1:Scrn Do
 .Write @F11,@F1
 .Do REFRESH^vhTERMINA()
 .Write sScr("PAGE")," "
 .w !,"REFRESH"
 .h 1
 q
KAP K  d INIT^vhTERMINA
 Set PRNr=0
 Kill Abd
 For  Set PRNr=$O(^KPR(PRNr))  Quit:'PRNr  Do
 .Quit:'$D(^KPR(PRNr,"J5005"))
 .Set KortT=$P(^KPR(PRNr,0),D,1)
 .Quit:KortT'["ABD"
 .Quit:$P(^KPR(PRNr,1),D,20)
 .Set Key=$E(KortT,1,8)
 .Set KLNr=0,Cnt=0
 .For  Set KLNr=$O(^KSTPR(PRNr,KLNr)) Quit:KLNr=""  Do
 ..Set Mnd="1994.06 "
 ..For  Set Mnd=$O(^KSTPR(PRNr,KLNr,Mnd)) Quit:Mnd=""  Do
 ...Set Cnt=Cnt+$P(^(Mnd),D)
 .S Abd(Key)=$G(Abd(Key))+Cnt
 zw Abd
 q
 Do
 .n FAKNr
 .d ^cA604
 S KLNr=1680
 If '$G(FAKNr) R !,"Faktuurnummer : ",FAKNr
 W "**** ",FAKNr," ****"
 Set FRec=^KFA("F",FAKNr,0,0)
 Quit:+FRec'=KLNr
 Set ULNr=0
 Set Mnd=$$CALCDATE^vhDTyp($$INTDATE^vhDTyp($P(FRec,D,6),"DK"),"M","MD")
 Set MndFmt=$$EXTDATE^vhDTyp(Mnd,"DM4")_" "
 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 Ln=^KFA("F",FAKNr,ULNr,LNr)
 ..Quit:$P(Ln,D,17)'="KF6"
 ..Set PRNr=$P(Ln,D,2)
 ..Quit:'PRNr
 ..Set Key=$O(^KPR(PRNr,"J"))
 ..I $E(Key)'="J" w PRNr,"****** J-NODE *****" Q
 ..Set CiffPPL=$P(^KPR(PRNr,Key),D,23)
 ..Set Lijst=$P(^KPR(PRNr,Key),D,25)
 ..Set EPr=$P(Ln,D,6)
 ..Set Aantal=$P(Ln,D,3)
 ..Set LPOmz=+$J(Lijst*Aantal,0,2) ; $P(Ln,D,32)
 ..Set APOmz=+$J(CiffPPL*Aantal,0,2) ; $P(Ln,D,33)
 ..Set VPOmz=+$J(EPr*Aantal,0,2) ;$P(Ln,D,34)
 ..Set Kom=$L($P($P(Ln,D,28),";"))
 ..Set NormPr=$$ZOEKPR(PRNr,FAKNr)
 ..Set NOmz=+$J(NormPr*Aantal,0,2)
 ..Set:'NOmz NOmz=VPOmz*10
 ..;w !,"LPOmz=",LPOmz," APOmz=",APOmz," VPOmz=",VPOmz," NOmz=",NOmz
 ..Do TUNELST(PRNr)
 ..;Do TUNEKL(PRNr),TUNEKL(0)
 ..;Do TUNEPR(KLNr),TUNEPR(0)
 ..;Do TUNEKAN(PRNr),TUNEKAN(0)
 Quit
ZOEKPR(PRNr,FAKNr) 
 New Dat,ULNr,LNr,Ln
 New Prijs
 Set Prijs=""
 Set Dat=-($P($P(FRec,D,6),".",3)_$P($P(FRec,D,6),".",2)_$P($P(FRec,D,6),".",1))
 For  Do  Quit:Prijs  Set Dat=$O(^KFA1("F",KLNr,Dat)) Quit:Dat=""
 .For  Set FAKNr=$O(^KFA1("F",KLNr,Dat,FAKNr),-1) Quit:FAKNr=""  Do  Quit:Prijs
 ..Set ULNr=0
 ..For  Set ULNr=$O(^KFA("F",FAKNr,ULNr)) Quit:ULNr=""  Do  Quit:Prijs
 ...Set LNr=99
 ...For  Set LNr=$O(^KFA("F",FAKNr,ULNr,LNr)) Quit:LNr=""  Do  Quit:Prijs
 ....Set Ln=^KFA("F",FAKNr,ULNr,LNr)
 ....Quit:$P(Ln,D,17)'="KF6"
 ....If PRNr=$P(Ln,D,2),$P(Ln,D,6)>(EPr*8) Set FAKTDAT=$P(^KFA("F",FAKNr,0,0),D,6),Prijs=$P(Ln,D,6),ManPrijs=$P(Ln,D,26) ;W !,Prijs,"-",FAKNr
 Quit Prijs
TUNELST(PRNr) 
 Set Rec=^KSTKL(KLNr,PRNr,0)
 Quit:'NormPr
 Quit:+$P(Rec,D,2)'=+EPr
 w !,$ZR," = ",Rec,!
 zw EPr
 Set $P(Rec,D,2)=NormPr
 Set $P(Rec,D,6)=$S($L(ManPrijs):1,1:"")
 Set $P(Rec,D,1)=FAKTDAT
 w $J("",$L($ZR))," = ",Rec
 Set ^KSTKL(KLNr,PRNr,0)=Rec 
 Quit
 
TUNEKL(PRNr) 
 Set Rec=^KSTKL(KLNr,PRNr,MndFmt)
 w !,$ZR," = ",Rec
 Set $P(Rec,D,1)=$P(Rec,D,1)-Aantal
 Set:Kom $P(Rec,D,5)=$P(Rec,D,5)-Aantal
 Set $P(Rec,D,2)=$P(Rec,D,2)-1
 Set $P(Rec,D,4)=$P(Rec,D,4)-(VPOmz-APOmz)+(NOmz-APOmz)-(NOmz*.9-APOmz)
 Set $P(Rec,D,6)=$P(Rec,D,6)-LPOmz
 w !,$J("",$L($ZR))," = ",Rec
 ;Set ^KSTKL(KLNr,PRNr,MndFmt)=Rec
 Quit
TUNEPR(KLNr) 
 Set Rec=^KSTPR(PRNr,KLNr,MndFmt)
 w !,$ZR," = ",Rec
 Set $P(Rec,D,1)=$P(Rec,D,1)-Aantal
 Set:Kom $P(Rec,D,5)=$P(Rec,D,5)-Aantal
 Set $P(Rec,D,2)=$P(Rec,D,2)-1
 Set $P(Rec,D,4)=$P(Rec,D,4)-(VPOmz-APOmz)+(NOmz-APOmz)-(NOmz*.9-APOmz)
 Set $P(Rec,D,6)=$P(Rec,D,6)-LPOmz
 w !,$J("",$L($ZR))," = ",Rec
 ;Set ^KSTPR(PRNr,KLNr,MndFmt)=Rec
 Quit
TUNEKAN(PRNr) 
 Set Rec=^KLKAN(KLNr,PRNr,Mnd)
 w !,$ZR," = ",Rec
 ;Set $P(Rec,D,14)=$P(Rec,D,14)-LPOmz
 ;Set $P(Rec,D,15)=$P(Rec,D,15)-APOmz
 w !,$J("",$L($ZR))," = ",Rec
 ;Set ^KLKAN(KLNr,PRNr,Mnd)=Rec
 Quit