KSCHADP ;Doorvoeren schaduwgegevens produkten ;KSCHAD; [ 10/27/2003  8:58 PM ]  ; Compiled May 13, 2004 09:48:30
 ;
1 S K=$P($T(+1),U,2)_QN_" ",FP=203+$L(K) W @F61,@F11,@F1,@F,@F5 S FP=202 W @F,@F4,K,@F5
112 W !!?2,"PRODUKTENBESTAND:",!?2,"Voor die produkten welke schadwgegevens bevatten:"
114 W !?2,"De huidige gegevens worden vervangen door de schaduwgegevens.",!?2,"Alle huidige gegevens worden terug berekend."
116 W !?2,"Alle schaduwgegevens verdwijnen."
 Set LEVNr=$$SELECT^LEVER(1)
118 S R="K\23\3\D[] = DOORVOEREN SCHADUWGEGEVENS   -[] = hernemen\\1\\""-D""[K&$L(K)" D R0 G YZ:K="-"
120 S R="K\24\3\D[] = DEFINITIEF DOORVOEREN SCHADUWGEGEVENS   -[] = hernemen\\1\\""-D""[K&$L(K)" D R0 G YZ:K="-"
15 S FP=1903 W @F,@F1,"OVERBRENGEN SCHADUWGEGEVENS PRODUKTEN"
150 L (@("^"_Q_"PR"),@("^"_Q_"PR1")):2 E  S FP=2403+F60 W @F,@F1,@F4,"PRODUKTENBESTAND IN GEBRUIK [] = ok ",@F5,@F0 R K G 150
 S FP=2103 W @F,"GROOTTEORDE" D GRORDE
 S FP=2103 W @F,"PRODUKT     :",!?2,"LEVERANCIER :" S PR=0
16 S PR=$N(@("^"_Q_"PR(PR)")) G YZ:PR=-1
 S PI2="J",X=@("^"_Q_"PR(PR,1)"),RMAS=$P(X,D,3),$P(@("^"_Q_"PR(PR,1)"),D,3)="",X=@("^"_Q_"PR(PR,2)")
 If LEVNr,'$D(^KPR(PR,"J"_LEVNr)) Goto 16
17 S PPLS=$P(X,D,3),PKS=$P(X,D,4),PVS=$P(X,D,5),PWS=$P(X,D,6),PCPS=$P(X,D,7),PKSWS=$P(X,D,10),CorFaktCifPPL=$P(X,D,26)
18 I '$L(PPLS),'$L(PKS),'$L(PVS),'$L(PWS),'$L(PCPS),'$L(RMAS),'$L(PKSWS),'$L(CorFaktCifPPL) G 16
 S PC=$P(@("^"_Q_"PR(PR,0)"),D,1),FP=2117 W @F,@F2,PC
19 S PI2=$N(@("^"_Q_"PR(PR,PI2)")) G 16:$E(PI2,1)'="J" S B(1)=^(PI2),LR=$P(B(1),D,1)
190 S LC=@("^"_Q_"L1(LR)"),LN=$P(@("^"_Q_"LE(LC,0)"),D,2),FP=2217 W @F,@F2,LN 
 ; G 19:"I"[$P(B(1),D,17) ; Inactief,oude kode : PV,25-10-2003
 ; Wissen schaduw en overbrengen naar huidig
 Set PRNr=PR
 If $L(PPLS) Do  ; PPL
 . Do PUTLOG^PRODUKT(PRNr,,PPLS,"","S-PPL (S>H)")
 . Set $P(@("^"_Q_"PR(PR,2)"),D,3)=""
 . If +PPLS'=+$P(B(1),D,19) Do  
 .. Do PUTLOG^PRODUKT(PRNr,,$P(B(1),D,19),PPLS,"PPL (S>H)")
 .. Set $P(B(1),D,19)=PPLS
 If $L(PKS) Do  ; korting
 . Do PUTLOG^PRODUKT(PRNr,,PKS,"","S-Kort% (S>H)")
 . Set $P(@("^"_Q_"PR(PR,2)"),D,4)=""
 . If +$P(B(1),D,9)'=+PKS Do
 .. Do PUTLOG^PRODUKT(PRNr,,$P(B(1),D,9),PKS,"Kort% (S>H)")
 .. Set $P(B(1),D,9)=PKS
 If $L(PVS) Do  ; Vork
 . Do PUTLOG^PRODUKT(PRNr,,PVS,"","S-Vork% (S>H)")
 . Set $P(@("^"_Q_"PR(PR,2)"),D,5)=""
 . If +$P(B(1),D,27)'=+PVS Do
 .. Do PUTLOG^PRODUKT(PRNr,,$P(B(1),D,27),PVS,"Vork% (S>H)")
 .. Set $P(B(1),D,27)=PVS
 If $L(PWS) Do  ; DB%
 . Do PUTLOG^PRODUKT(PRNr,,PWS,"","S-DB% (S>H)")
 . Set $P(@("^"_Q_"PR(PR,2)"),D,6)=""
 . If +$P(B(1),D,24)'=+PWS Do
 .. Do PUTLOG^PRODUKT(PRNr,,$P(B(1),D,24),PWS,"DB% (S>H)")
 .. Set $P(B(1),D,24)=PWS
 If $L(PCPS) Do  ; Cif%
 . Do PUTLOG^PRODUKT(PRNr,,PCPS,"","S-Cif% (S>H)")
 . Set $P(@("^"_Q_"PR(PR,2)"),D,7)=""
 . If +$P(B(1),D,21)'=+PCPS Do
 .. Do PUTLOG^PRODUKT(PRNr,,$P(B(1),D,21),PCPS,"Cif% (S>H)")
 .. Set $P(B(1),D,21)=PCPS
 If $L(PKSWS) Do  ; KSDB%
 . Do PUTLOG^PRODUKT(PRNr,,PKSWS,"","S-KSDB% (S>H)")
 . Set $P(@("^"_Q_"PR(PR,2)"),D,6)=""
 . If +$P(B(1),D,10)'=+PKSWS Do
 .. Do PUTLOG^PRODUKT(PRNr,,$P(B(1),D,10),PKSWS,"KSDB% (S>H)")
 .. Set $P(B(1),D,10)=PKSWS
 If $L(RMAS) Do  ; Munt
 . Do PUTLOG^PRODUKT(PRNr,RMAS,"","S-Munt (S>H)")
 . S $P(@("^"_Q_"PR(PR,1)"),D,3)=""
 . If $P(B(1),D,17)'=RMAS Do
 .. Do PUTLOG^PRODUKT(PRNr,,$P(B(1),D,17),RMAS,"Munt (S>H)")
 .. Set $P(B(1),D,17)=RMAS
 If $L(CorFaktCifPPL) Do  ; Correctie factor CifPPL
 . Do PUTLOG^PRODUKT(PRNr,,CorFaktCifPPL,"","S-Corr CifPPL (S>H)")
 . Set $P(@("^"_Q_"PR(PR,2)"),D,26)=""
 . If +$P(B(1),D,8)'=+CorFaktCifPPL Do
 .. Do PUTLOG^PRODUKT(PRNr,,$P(B(1),D,8),CorFaktCifPPL,"Corr CifPPL (S>H)")
 .. Set $P(B(1),D,8)=CorFaktCifPPL
 ; Prijsherekening
 D RECALC^PRODUKT2(PR,B(1))
 b
 K RHM,RI,RMA,RP,RPL,RPLL,RV,RVP,RW,R,R9,PRNr
 G 16 ; volgend product
YZ Q
 ;
GRORDE 
 New R,KKey
 Set KKey=""
 For  Set KKey=$O(^KLAS("K",KKey)) Quit:KKey=""  Do
 .Set R=^KLAS("K",KKey)
 .Quit:$P(R,D,15)=""
 .Set $P(R,D,14)=$P(R,D,15),$P(R,D,15)="",^KLAS("K",KKey)=R
 Quit
 ;
R0 S R7=1 S:$P(R,D,8)'="" R7=R7_"&("_$P(R,D,8)_")" S:$P(R,D,7)'="" R7=R7_"&("_$P($T(@$P(R,D,7))," ",2,99)_")"
R0A S R2=$P(R,D,2),R3=$P(R,D,3),R4=$P(R,D,4),R5=$P(R,D,5),R6=$P(R,D,6)
R0B S R0=$L(R4)+R3+3 S FP=R2*100+R3+F60 W @F W:R3<4 @F1 W @F2,R4," : " I R5'="" W:R5["""" !,?2,@R5 D:R5'["""" @R5
R0C S FP=R2*100+R0+F60 W @F,@F2,$E("........................................",1,R6),@F,@F0
R0D R K W @F2 I $L(K)'>R6,K'[D&(K'?.E1C.E),@R7 S @$P(R,D,1)=K
R0E E  G R0C
R0F S FP=$P(R,D,9)*100+($P(R,D,10)*1) I FP W @F,$J("",R6),@F,K
R0Z K R,R0,R2,R3,R4,R5,R6,R7 Q  ;V5 02.01.86
 ;