KP0NL G 5 ;OPENEN - RRADPL. - WIJZ. PRODUKTEN LEVERANCIERS ;Quit naar %P15, %P20, %P33 [ 03/14/2002  10:46 AM ]
 ;
R S R9=$E(RAF),R=R*$S(R9="H":100,1:1)
 S R9=$E(RAF,2)
 S R=$$ROUND^KPRIJS(R)
 Q
 ;
S(RNR) 
 N RI
 S RI=100
 F  S RI=$O(A(RI)) Q:'RI  Q:$P(A(RI),U,16)=RNR
 D:RI
 .S FP=$P(A(RI),U,5)*100+$P(A(RI),U,6)-1 W @F,@F5
 .D C(RNR)
 Q
 ;
C(RNR) 
 N RI
 S RI=100
 F  S RI=$O(A(RI)) Q:'RI  Q:$P(A(RI),U,16)=RNR
 D:RI
 .S FP=$P(A(RI),U,5)*100+$P(A(RI),U,6)
 .W @F,$J("",$P(A(RI),U,9))
 .W:$L($P(A(RI),U,13)) $J("",$P(A(RI),U,13)) W @F
 Q
 ;
W(RNR,VAL,LEN,BOLD) 
 S VAL=$G(VAL),LEN=$G(LEN),BOLD=$G(BOLD)
 D S(RNR)
 I VAL'="" D
 .S VAL=$$EXTNUM(VAL,0,".",$L($P(VAL,".",2)))
 .W $J("",LEN-$L(VAL)) W:BOLD @FMTB W VAL W:BOLD @FMTb
 Q
 ;
1 S RW=100*K/($P(B(1),D,23)+K),RW=$J(RW,1,0),B(1)=$P(B(1),D,1,23)_D_RW_D_$P(B(1),D,25,99) G 5
 ;
2 S RW=100-($P(B(1),D,23)/K*100),RW=$J(RW,0,$$ABDCFRS()),B(1)=$P(B(1),D,1,23)_D_RW_D_$P(B(1),D,25,99) G 5
 ;
3 S RVP=K*100/$P(B(1),D,25),RVP=+$J(RVP,0,2),B(1)=$P(B(1),D,1,26)_D_RVP_D_$P(B(1),D,28,99) G 5
 ;
5 I $G(EXTRA)="X" D IK^PROC K EXTRA
 S RMA=$P(B(1),D,17),(RP,RPL)=$P(B(1),D,19)
7 S:$P(B(1),D,28)="H" RPL=RPL/100 S:$P(B(1),D,28)="M" RPL=RPL/1000
 S RPL=RPL*(1/$$MUNTPAR^vhRtn1(RMA,1))*(100-$P(B(1),D,9))/100*(100-0)/100*(100+$P(B(1),D,21))/100
 N ABdCfrs
 S ABdCfrs=$$ABDCFRS()
 S RAF=$$GRORDE^PRODUKT2(PR)
9 S RPL=$J(RPL,1,ABdCfrs),R=RPL D R S RPLL=R,RW=0 S:RPL RW=$P(B(1),D,24)
 S RHM=RPL/(100-RW/100)*RW/100,RHM=$J(RHM,1,ABdCfrs),R=RPL+RHM D R S RLPP=R
 S RV=RPL+RHM*$P(B(1),D,27)/100,RV=$J(RV,1,ABdCfrs),R=RV
 S R9=$E(RAF),R=R*$S(R9="H":100,1:1)
90 S R9=$E(RAF,2) S:R9=1 R=R*100\1/100 S:R9=2 R=R*100\5*5/100 S:R9<3 R=$J(R,2,2) S:R9=3 R=R\1 S:R9=4 R=R\5*5 S:R9=5 R=R\10*10
10 S RVV=R,RVP=0 S:(RPL+RHM) RVP=RV/(RPL+RHM)*100,RVP=+$J(RVP,0,2)
11 S B(1)=$P(B(1),D,1,19)_D_RHM_D_$P(B(1),D,21,22)_D_RPL_D_RW_D_(RPL+RHM)_D_RV_D_RVP_D_$P(B(1),D,28,99)
13 G YZ:$D(P24)!$D(BLZ)
 D W(119,RP,10,1)
 D W("N",$J(RP*(100-$P(B(1),D,9))/100,0,2),10,0)
 D W(123,RPLL,10,1)
14 D W(120,RLPP-RPLL,10)
 D S(124) W:RW $$EXTNUM(RW,5,"",2) W:$L($P(RW,".",2))>2 "*"
 D W(125,RLPP,10,1)
 D W(126,RVV,10)
15 D S(127) W:RVP $$EXTNUM(RVP,5,"",2)
 I RV>RHM D S(126) W @F,$J("",10-$L(RVV)),@FMTI,RVV,@FMTi
17 G YZ
 ;
19 S B(1)=$P(B(1),D,1,8)_D_D_D_$P(B(1),D,11,16)_D_D_$P(B(1),D,18)_D_D_D_D_$P(B(1),D,22)_D_D_D_D_D_D_D_$P(B(1),D,29,99)
21 G YZ:$D(P24)!$D(BLZ) F RNR=119,109,123,120,124:1:127,113 D C(RNR)
23 G YZ
 ;
YZ K RAF,RHM,RNR,RMA,RP,RPL,RV,RVP,RW,R,R9,RKPC,RCPC,RVPC Q
 ;
VWAUTOL(PR) 
 New R,HoofdGr,Groep,SubGroep,IDNr
 Set IDNr=$P(^KPR(PR,2),D,25)
 If $TR($E(IDNr,4,8),".","")'=PR Quit 1
 Set R=$O(^KPR(PR,"I")),R=^KPR(PR,R),HoofdGr=$P(R,D),Groep=$P(R,D,2),SubGroep=$P(R,D,3)
 Quit $D(^KPH(HoofdGr,Groep,SubGroep))
 ;
AUTOL(PR) 
 New R,HoofdGr,Groep,SubGroep,KortComp,NPRNr,IDNr
 Set IDNr=$P(^KPR(PR,2),D,25)
 If $TR($E(IDNr,4,8),".","")'=PR Set R=5005
 Else  Do
 .Set R=$O(^KPR(PR,"I")),R=^KPR(PR,R),HoofdGr=$P(R,D),Groep=$P(R,D,2),SubGroep=$P(R,D,3),KortComp=""
 .For  Set KortComp=$O(^KPH(HoofdGr,Groep,SubGroep,"  ",KortComp)) Do  Quit:NPRNr'=PR
 ..Set NPRNr=^KPH(HoofdGr,Groep,SubGroep,"  ",KortComp)
 .Set R=$O(^KPR(NPRNr,"J")),R=$E(R,2,9)
 Set LV=R,LX=^KL1(LV)
 Quit R
 ;
ABDCFRS() 
 Quit 4+$$MUNT^vhRtn1(,4)
 ;
GETVAL(PRNr,Node,Piece) 
 New R,Value
 Set Value=""
 If PRNr,$D(^KPR(PRNr)),$L(Node) Do
 .Set R=""
 .If Node'?.N,$E($O(^KPR(PRNr,Node)))=Node Set Node=$O(^KPR(PRNr,Node))
 .Set R=$G(^KPR(PRNr,Node)),Value=$P(R,D,Piece)
 Quit Value
 ;
SCHAD(PRNr) 
 New Schaduw,Next,U2,Spaces
 Merge:'$D(ALS) ALS=A
 Kill A
 MERGE A=ALS
 Set Schaduw=$$SchaduwIsActief(PRNr)
 Set SW5=1
 Quit:Schaduw
 Set Next=100
 For  Set Next=$O(A(Next)) Quit:'Next  Do
 .Set U2=A(Next)
 .Quit:$E($P(U2,U,16))'="S"
 .Set Spaces=$P(U2,U,6)-$P(U2,U,3)-3 Set:Spaces<$L($P(U2,U)) Spaces=$L($P(U2,U))
 .Set FP=$P(U2,U,2)*100+$P(U2,U,3)+3 Set:'Spaces FP=FP-5,Spaces=1
 .Write @F,$J("",Spaces)
 .Set FP=$P(U2,U,5)*100+$P(U2,U,6)
 .Write @F,$J("",$P(U2,U,9)+$P(U2,U,13))
 .Kill A(Next)
 Quit
 ;
SW 
 New Schaduw,RMA,RCORR
 Set Schaduw=$$SchaduwIsActief(PR)
 G YZ:'Schaduw
 S RMA=$$GETVAL(PR,1,3) S:RMA="" RMA=$P(B(1),D,17)
 S RP=$$SchaduwPPL^KPRIJS(PR) S:RP="" RP=$P(B(1),D,19) S RPL=RP
 D
 .N PEA
 .S PEA=$$GO(PR)
 .S:PEA="H" RPL=RPL/100 S:PEA="M" RPL=RPL/1000
 S RKPC=$$GETVAL(PR,2,4) S:RKPC="" RKPC=$P(B(1),D,9)
 S RCPC=$$GETVAL(PR,2,7) S:RCPC="" RCPC=$P(B(1),D,21)
 S RPL=RPL*(1/$$MUNTPAR^vhRtn1(RMA,1,"S"))*(100-RKPC)/100*(100-0)/100*(100+RCPC)/100
 N ABdCfrs
 S ABdCfrs=$$ABDCFRS()
 S RAF=$$GRORDE^PRODUKT2(PR,"S")
 S RPL=$J(RPL,1,ABdCfrs),R=RPL D R S RPLL=R,RW=0
 I RPL S RW=$$GETVAL(PR,2,6) S:RW="" RW=$P(B(1),D,24)
 S RHM=RPL/(100-RW/100)*RW/100,RHM=$J(RHM,1,ABdCfrs),R=RPL+RHM D R S RLPP=R
 S RVPC=$$GETVAL(PR,2,5) S:RVPC="" RVPC=$P(B(1),D,27)
 S RV=RPL+RHM*RVPC/100,RV=$J(RV,1,ABdCfrs),R=RV
 S R9=$E(RAF),R=R*$S(R9="H":100,1:1)
 S R9=$E(RAF,2) S:R9=1 R=R*100\1/100 S:R9=2 R=R*100\5*5/100
 S:R9<3 R=$J(R,2,2) S:R9=3 R=R\1 S:R9=4 R=R\5*5 S:R9=5 R=R\10*10
 S RVV=R,RVP=0 S:(RPL+RHM) RVP=RV/(RPL+RHM)*100,RVP=+$J(RVP,0,2)
 S RCORR=$$GETVAL(PR,2,26) S:RCORR="" RCORR=$P(B(1),D,8)
 G YZ:$D(P24)!$D(BLZ)
 D W("SP",RP,10,1)
 D W("SN",$J(RP*(100-$S($L($$GETVAL(PR,2,4)):$$GETVAL(PR,2,4),1:$P(B(1),D,9)))/100,0,2),10,0)
 D W("SC",RPLL,10,1)
 D W("SM",RLPP-RPLL,9)
 D W("SL",RLPP,10,1)
 D W("SV",RVV,10)
 D W("SR",RCORR,9)
 I RV>RHM D S("SV") W @F,$J("",10-$L(RVV)),@FMTI,RVV,@FMTi
 G YZ
 ;
AGO(PR) 
 N AGO
 S AGO=$$GETVAL(PR,"J",28),AGO=$J($S(AGO="E":"",AGO="H":"/%",1:"/"_AGO),2)
 Q AGO
 ;
VGO(PR) 
 N X,VGO
 S X="S VGO=$E($$GRORDE^PRODUKT2(PR"_$S($G(Schaduw):",""S""",1:"")_"))"
 X X S:VGO="" VGO="E"
 S VGO=$J($S(VGO="E":"",VGO="H":"/%",1:"/"_VGO),2)
 Q VGO
 ;
EXTNUM(Value,Length,Format,Decimals) 
 Set Value=$G(Value),Length=$G(Length),Format=$G(Format),Decimals=$G(Decimals)
 Set Value=$$EXTNUM^vhLib.DataTypes(Value,Length,Format,Decimals)
 Set:Value="" Value=$J(Value,Length)
 Quit Value
 ;
GO(PRNr) 
 New J,IDNr,Rec,PEA
 Set IDNr=$P(^KPR(PRNr,2),D,25)
 Set BLID=$$TRIMIDENT^vhRtn1(IDNr) ;[IDENT] CW
 Set $E(BLID)=0
 Set Rec=$G(^BLProd("D",BLID))
 If 0,$L(Rec) Set PEA=$P(Rec,D,12)
 Else  Set J=$O(^KPR(PRNr,"J")) Set:$E(J)="J" Rec=^KPR(PRNr,J) Set PEA=$P(Rec,D,28)
 Quit PEA
 ;
%LP(PRNr) 
 New %LP,NLijstP,SLijstP
 Set NLijstP=$P($$PROD^KPRIJS(PRNr,"","",""),D)
 Set SLijstP=$P($$PROD^KPRIJS(PRNr,"","","","","","S"),D)
 Set %LP=$$%NS(NLijstP,SLijstP) Set:$L(%LP) %LP=$$EXTNUM^vhLib.DataTypes(%LP,9,"+",2)_"%"
 Quit %LP
 ;
%NS(Norm,Schad,NMunt,SMunt,NGrOrd,SGrOrd) 
 New %NS
 Set NMunt=$G(NMunt),SMunt=$G(SMunt),NGrOrd=$G(NGrOrd),SGrOrd=$G(SGrOrd)
 Set Norm=Norm/$S(NGrOrd="H":100,1:1),Schad=Schad/$S(SGrOrd="H":100,1:1)
 If Norm,Schad Set %NS=Schad/$$MUNTPAR^vhRtn1(SMunt,2,"S")/(Norm/$$MUNTPAR^vhRtn1(NMunt,2))-1*100
 Else  If 'Norm,'Schad
 Else  Set %NS=$S(Norm:"-",1:"")_100
 Quit $G(%NS)
 ;
SNS 
 Kill BTemp
 Merge BTemp=B
 Set $P(B(1),D,19)=$$SchaduwPPL^KPRIJS($G(PR))
 Set $P(B(1),D,9)=$$GETVAL($G(PR),2,4)
 Set $P(B(1),D,27)=$$GETVAL($G(PR),2,5)
 Set $P(B(1),D,24)=$$GETVAL($G(PR),2,6)
 Set $P(B(1),D,21)=$$GETVAL($G(PR),2,7)
 Set $P(B(1),D,17)=$$GETVAL($G(PR),1,3)
 Quit
 ;
 ; Zijn de schaduwprijzen actief?
SchaduwIsActief(PRNr) 
 New IsActief,Piece
 Set IsActief=1
 ;If $$IsActief^KLPUTZ2("S")="B" Set IsActief=$$IsActief^KLPUTZ2("S",QU(1)) ; Schaduw beperkt actief ; Afgesloten CW 14.01.09
 Do:IsActief  ; Zijn er schaduwgegevens ingevuld?
 . Set IsActief=0
 . For Piece=4:1:7,26 Set IsActief=$L($$GETVAL(PRNr,2,Piece)) Quit:IsActief
 . Set:'IsActief IsActief=$L($$GETVAL(PRNr,1,3))
 . Set:'IsActief IsActief=$L($$SchaduwPPL^KPRIJS(PRNr))
 Quit IsActief