cAFE5 ;Functies ivm decimalen ;%AFE5 ; [ 10/04/00  1:55 PM ]
 G YZ
 ;
T0 ;Functies ivm afrondingen ;
 ;
T0F ;Fonctions conc. arrondir ;
 ;
T0E ;Functies ivm afrondingen ;
 ;
 ; ********************* Nieuwe functies ivm decimalen ****************
 ;
DEC(SP,UPRDMS) ; ophalen decimalen input/output prijzen
 ; SP = soort ("V" = verkoop, "A" = aankoop)
 ; UPRDMS = DMS voor producten (niet bestaand = "PR")
 N R
 D S1
 S R=$P($G(@("^"_Q_$G(UPRDMS,"PR")_"(0,19)")),D,$G(SP,"V")="A"+39)
 I '$L(R) S R=4
 D S2
 Q R
 ;
DECR(RM,SP,UPRDMS) ; ophalen decimalen voor berekende prijzen
 ; RM = munt
 ; SP = soort ("V" = verkoop, "A" = aankoop)
 ; UPRDMS = DMS voor producten (niet bestaand = "PR")
 N R,BA39 D S1
 S BA39=@("^"_Q_"BA(39)")
 I '$L($G(RM)) S RM=$P(BA39,D)
 ; indien firmamunt
 I RM=$P(BA39,D) S R=+$P($G(@("^"_Q_$G(UPRDMS,"PR")_"(0,19)")),D,$S($G(SP,"V")="V":2,1:22)) G DECRZ
 ; indien EUR (P1,P2,P3) of oude firmamunt (P4 ev...)
 I RM=$S($L($P(BA39,D,11)):$P(BA39,D,9),1:$S($L($P(BA39,D,7)):$P(BA39,D,7),1:"EUR")) S R=+$P($G(@("^"_Q_$G(UPRDMS,"PR")_"(0,19)")),D,$G(SP)="A"+56) G DECRZ
 S R=$P($G(@("^"_Q_"BA(11,RM)")),D,7)
DECRZ D S2 Q R
 ;
EP(K,SP,UPRDMS,POS,POSDEC) ; drukken eenheidsprijs vanuit de 800 reeks
 ; K = prijs
 ; SP = soort ("V" = verkoop, "A" = aankoop)
 ; UPRDMS = DMS voor producten (niet bestaand = "PR")
 ; POS = aantal posities (niet bestaand : 12)
 ; POS = aantal posities decimalen (niet bestaand : 2)
 ;
 S POS=$G(POS),POSDEC=$G(POSDEC)
 S:'$L(POS) POS=12 S:'$L(POSDEC) POSDEC=2
 I POSDEC S POSDEC=POSDEC+1
 S K=$$OUT(K,UQD,$G(SP,"V"),$G(UPRDMS,"PR"),1)
 S R=$P(K,D)_D_($P(K,D,2)'>0*-POSDEC+POS)_"\\"_$P(K,D,2)_"\1" D ^cA103
 Q
 ;
EPO(K,MO,SP,UPRDMS,MI,C,DEC,DECO,NOPRINT)     ;berekenen prijs van MI naar MO en afronding + OUT
 ; K = prijs
 ; MI = muntcode input
 ; MO = muntcode output
 ; SP = soort ("V" = verkoop, "A" = aankoop)
 ; UPRDMS = DMS voor producten (niet bestaand = "PR")
 ; C = Coëff. waarmee K kan vermenigvuldigd worden
 ; indien $L(DEC) : steeds met DEC rekenen
 ; DECO = minimum aantal decimalen te printen
 ; NOPRINT = wordt niet direct geprint (w $$OUT...) 
 ;
 S K=$$EPR(K,$G(MO),$G(SP),$G(UPRDMS,"PR"),$G(MI),$G(C),$G(DEC))
 S K=$$OUT(K,$G(DECO,$$DECVM($G(MO))),$G(SP),$G(UPRDMS,"PR"),$G(NOPRINT))
 Q K
 ;
EPR(K,MO,SP,UPRDMS,MI,C,DEC)     ;berekenen prijs van MI naar MO en afronding
 ; K = prijs
 ; MI = muntcode input
 ; MO = muntcode output
 ; SP = soort ("V" = verkoop, "A" = aankoop)
 ; UPRDMS = DMS voor producten (niet bestaand = "PR")
 ; C = Coëff. waarmee K kan vermenigvuldigd worden
 ; indien $L(DEC) : steeds met DEC rekenen
 D S1
 S DEC=$G(DEC)
 I '$L(K) G EPRZ
 I '$L($G(C)) S C=1
 I '$L($G(MI)) S MI=$P(@("^"_Q_"BA(39)"),D)
 I '$L($G(MO)) S MO=$P(@("^"_Q_"BA(39)"),D)
 I $FN(C,"-")=1,MI=MO G EPRZ
 S K=K*C
 I '$L(DEC) S DEC=$$DECR(MO,$G(SP,"V"),$G(UPRDMS,"PR"))
 I MI'=MO S K=$$OMREK^cAFE1(Q,K,MI,MO,$G(SP,"V"),DEC)
 S K=+$J(K,0,DEC)
EPRZ D S2 Q K
 ;
IN(K,SP,UPRDMS) ; kontrole input
 ; K = prijs
 ; SP = soort ("V" = verkoop, "A" = aankoop)
 ; UPRDMS = DMS voor producten (niet bestaand = "PR")
 N DEC,R
 S DEC=$$DEC($G(SP,"V"),$G(UPRDMS,"PR"))
 S R=0 X "I K?.N!((K?.N1"".""."_DEC_"N)&DEC) S R=1"
 Q R
 ;
KORT(K,SP,UPRDMS,POS,POSDEC) ; drukken korting vanuit de 800 reeks
 ; K = prijs
 ; SP = soort ("V" = verkoop, "A" = aankoop)
 ; UPRDMS = DMS voor producten (niet bestaand = "PR")
 ; POS = aantal posities (niet bestaand : 9)
 ; POSDEC = aantal posities decimalen (niet bestaand : 2)
 ;
 S POS=$G(POS),POSDEC=$G(POSDEC)
 S:'$L(POS) POS=9 S:'$L(POSDEC) POSDEC=2
 I POSDEC S POSDEC=POSDEC+1
 I K["%" D  G KORTZ
 . N R0,R1
 . S R0=$E(K),K=$E(K,2,$L(K)-1),R1=0
 . I K["." S K=$J(K,0,2),K=$P(K,".")_","_$P(K,".",2,99),R1=2
 . S K=R0_K_"%" W $J(K,$S($P($G(U8),U,9):$P(U8,U,9),1:POS)-$S(R1:0,1:POSDEC))
 S K=$$OUT(K,UQD,$G(SP,"V"),$G(UPRDMS,"PR"),1)
 S R=$P(K,D)_D_($P(K,D,2)'>0*-POSDEC+POS)_"\\"_$P(K,D,2)_"\1" D ^cA103
KORTZ Q
 ;
KORTLK ; nominale kortingen bij leveringen per klant
 I K'["%" S $P(U8,U,17)=$P($$OUT^cAFE5(K,UQD,$S($E(UGL,1,2)="TO":"A",1:"V"),$G(UPRDMS,"PR"),1),D,2) S:'$P(U8,U,17) $P(U8,U,17)=2
 Q
 ;
OUT(K,RD,SP,UPRDMS,NOPRINT)          ; bepalen output + dec.
 ; K = prijs
 ; RD = aantal decimalen
 ; SP = soort ("V" = verkoop, "A" = aankoop)
 ; UPRDMS = DMS voor producten (niet bestaand = "PR")
 ; NOPRINT = wordt niet direct geprint (w $$OUT...) 
 N DEC,I
 S DEC=$S(K#1:$L($P(K,".",2)),1:RD)
 I DEC=1 S DEC=2
 ; S I=$$DEC($G(SP,"V"),$G(UPRDMS,"PR"))
 I DEC>4 S DEC=4
 I $L(K) S K=$J(K,0,DEC)
 I $G(NOPRINT) S K=K_D_DEC
 Q K
 ;
PRBE(Q,BE,SP,UPRDMS,MO,MI,DAT)   ; prijs in BEF of EUR
 ; input: 1. Q : Q-waarde
 ;        2. BE: bedrag
 ;        3. SP: soort pariteit ("V" = verkoop, "A" = aankoop)
 ;        4. DAT : datum ("" of niet bestaand = DT)
 ;        5. MO : muntcode output ("" of niet bestaand : volgens per.)
 ;        6. MI : muntcode input ("" of niet bestaand : firmamunt
 ; output: te printen bedrag en muntcode en dec. muntcode
 N BA39,DTC,P4C,R D S1
 D ^cA106
 S BA39=$G(@("^"_Q_"BA(39)"))
 S:'$L($G(DAT)) DAT=DT
 S:'$L($G(MI)) MI=$P(BA39,D)
 S:'$L($G(UPRDMS)) UPRDMS="PR"
 S:'$L($G(SP)) SP="V"
 I '$L($G(MO)) D
 . S MO=$P(BA39,D,9)               ; P4 en hoger
 . S DTC=$$DC(DAT),P4C=$$DC($P(BA39,D,11))
 . I DTC<P4C!'$L(P4C) S MO="EUR"   ; P1,P2,P3
 S R=$$EPR(BE,MO,SP,UPRDMS,MI)
PRBEZ D S2 Q R_D_MO_D_$$DECVM(MO)  ; bedrag_D_munt_D_min. aantal dec.
 ;
YZ Q
 ;
 ; *********************** Gekopieerde functies ***********************
S1 S RZR=$ZR           ; onthouden last reference
S1Z Q
 ;
S2 I $O(@RZR)          ; terugzetten last reference
S2Z Q
 ;
BF() ; muntkode BF ophalen
 N R S R=$P($G(@("^"_Q_"BA(39)")),D) I R="" S R="BEF"
 Q R
 ;
DC(R) ; datum conversie (kopie van %AFD1)
 I R?2N1"."2N1"."2N S R=$E(R,7,8)<50+19_$E(R,7,8)_$E(R,4,5)_$E(R,1,2)
 Q R
 ;
DECVM(VM) ; decimalen muntkode
 N R
 D S1
 I $L(VM) S R=2 I $D(@("^"_Q_"BA(11,VM)")) S R=+$P(^(VM),D,7)
 I VM=$$BF!(VM="") S R=QD
 D S2
 Q R
 ;
 ; error Trap (kopie van TRAP^cAN000)
TRAP S %=$ZE,%ZR=$ZR,%UCI=$ZU(5) I $ZV'["MSM" S %ZTRAP="TRAP^"_$T(+0)
TRAPA I $ZV["MSM",%'["<INTERRUPT>",%'["<DBOVF>",%'["<FILEFULL>",%'["<DKRES>",%'["<SYSTEM>" D ^cA400
TRAPB I $ZV'["MSM",%'["<INTERRUPT>",%'["<DATABASE>",%'["<FILEFULL>",%'["<DISKHARD>",%'["<SYSTEM>" D ^cA400
TRAPX I $ZV["MSM" ZQ
TRAPY I $ZV'["MSM" ZQ 1 I $ZT'="" G @$ZT
TRAPZ Q
 ;
ZZ ; 05.02.01 - 16 u 23 * V7.84