#include Prod.Product
KSCHADP ;Doorvoeren schaduwgegevens produkten ;KSCHAD; [ 10/27/2003  8:58 PM ]
 ;
 Set K=$P($T(+1),U,2)_QN_" ",FP=203+$L(K)
 Write @F61,@F11,@F1,@F,@F5
 Set FP=102
 Write @F,@F4,K,@F5
 Write !?1,@FMTB,"PRODUKTENBESTAND:",@FMTb
 Write !?3,"Voor die produkten welke schadwgegevens bevatten:"
 Write !?3,"De huidige gegevens worden vervangen door de schaduwgegevens."
 Write !?3,"Alle huidige gegevens worden terug berekend."
 Write !?3,"Alle schaduwgegevens verdwijnen."
 Write !?1,@FMTB,"BOUWSTENEN:",@FMTb
 Write !?3,"Indien er schaduwbouwstenen bestaan"
 Write !?3,"dan worden de huidige vervangen door de schaduwbouwstenen"
 Write !?3,"Alle schaduwbouwstenen worden daarna verwijderd"
 Write !?1,@FMTB,"KLASSIFICATIE",@FMTb
 Write !?3,"Indien  er schaduwgrootteorde is ingevuld"
 Write !?3,"dan worden de huidige vervangen door de schaduwgrootteorde"
 Write !?3,"Alle schaduwgrootteorde wordt daarna verwijderd"
 ;Write !?1,@FMTB,"ORGALUX wordt niet overgedragen !",@FMTb
 
 Set FP=2001
 Write @F,"Beperking op leverancier"
 Set LEVNr=$$SELECT^LEVER(1),FP=1701
 Write @F,@F1,@FMTB," LEVERANCIER : ",@FMTb,$S(LEVNr:"beperkt tot "_LEVNr_" "_$P(^KLE(^KL1(LEVNr),0),D,2),1:"ALLE")
 
 Set FP=2001
 Write @F,"Beperking op klassificatie"
 Set KKey=$P($$SELECT^KLASS(-3),D),FP=1801
 Write @F,@F1,@FMTB," KLASSIFICATIE : ",@FMTb,$S(KKey:"beperkt tot "_$$DISPL^KLASS(KKey),1:"ALLE")
 
 If LEVNr||KKey Do
 . Set FP=1901
 . Write @F,"Er is een klassificatie of een leverancier in gevuld."
 . Write !,"De grootteorde in klassificatie wordt niet overgedragen."
 . Read !,"Druk op enter om verder te gaan.",K

 Set R="K\23\3\D[] = DOORVOEREN SCHADUWGEGEVENS   -[] = hernemen\\1\\""-D""[K&$L(K)"
 Do R0 Do:K'="-"
 . Set R="K\24\3\D[] = DEFINITIEF DOORVOEREN SCHADUWGEGEVENS   -[] = hernemen\\1\\""-D""[K&$L(K)"
 . Do R0
 . Quit:K="-"
 . Set FP=1903
 . ;For  Do ADD^vhLock("^KPR") Quit:%TC  Do LDISP^vhLock("^KPR","Productenbestand")
 . ;For  Do ADD^vhLock("^PRBS") Quit:%TC  Do LDISP^vhLock("^PRBS","Bouwstenenbestand")
 . If '(LEVNr||KKey) Do
 . . Set FP=2103
 . . Write @F,"Bezig met overbrengen grootteorde in klassificatie"
 . . Do GRORDE
 . Set FP=2101
 . Write @F,@F1,"  Bezig met product :"
 . Set PRNr=0,(ModCnt,Cnt)=0
 . For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
 .. If LEVNr,'$D(^KPR(PRNr,"J"_LEVNr)) Quit
 .. If KKey,'$$CheckKlassificatie(PRNr,KKey) Quit
 .. ;If '$$ISORGAL^ORGALUX(PRNr) Quit
 .. Set Cnt=Cnt+1
 .. Set isBSMod=$$BOUWSTEEN(PRNr) ; copieren van bouwsteen
 .. Set isProdMod=$$PRODUCT(PRNr) ; productgegevens
 .. If isProdMod||isBSMod Set ModCnt=ModCnt+1
 .. Do DISPPROD(PRNr,ModCnt,Cnt)
 Lock -^KPR,-^PRBS
 Write !,"Druk op enter om het programma te verlaten" r k
 Quit
 ;
 
CheckKlassificatie(PRNr,IngegevenKKey)
	Set IngegevenNiveau=$P(^KLAS("K",IngegevenKKey),D)
	Set ProductKKey=$$$PRGet($$$KlassificatieKey)
	If IngegevenNiveau=3 {
		Set Check=IngegevenKKey=ProductKKey
	} elseif IngegevenNiveau=2 {
		Set Check=IngegevenKKey=$P(^KLAS("K",ProductKKey),D,9)
	} elseif IngegevenNiveau=1 {
		Set Check=IngegevenKKey=$P(^KLAS("K",ProductKKey),D,8)
	} else {
		Set Check=0
	}
 	Quit Check
 	
GRORDE ; grootteorde in klassificatie van schaduw -> huidig
 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
 
BOUWSTEEN(PRNr) ; bouwstenen copieren
 
 Quit:'$D(^PRBS("BSS",PRNr)) 0 ; geen schaduw
 
 ;Do LOCK^PRBS(PRNr) ; lock niet nodig want ganse PRBS global is gelockt
 Do COPYOBJ^PRBS(PRNr,"S") ; van schaduw naar normaal
 ;Do UNLOCK^PRBS(PRNr)
 Quit 1
 
PRODUCT(PRNr) ; gegevens in KPR
 New B,R,%TC,KortTxt,SchPPL,SchKortP,SchCifP,SchDBP,SchVorkP,SchMunt,SchKatPr,SchKatPrHand,SchGrOrde,JNode,CorFaktCifPPL
 Set R=^KPR(PRNr,1),SchMunt=$P(R,D,3),SchGrOrde=$P(R,D,14),SchKatPrHand=$P(R,D,15),SchKatPr=$P(R,D,16)
 Set R=^KPR(PRNr,2),SchPPL=$$SchaduwPPL^KPRIJS(PRNr),SchKortP=$P(R,D,4),SchVorkP=$P(R,D,5),SchDBP=$P(R,D,6),SchCifP=$P(R,D,7)
 Set CorFaktCifPPL=$P(R,D,26)
 If SchMunt="",SchGrOrde="",SchKatPrHand="",SchKatPr="",SchPPL="",SchKortP="",SchVorkP="",SchDBP="",SchCifP="",CorFaktCifPPL="" Quit 0
 Else  Do
 . Set JNode=$O(^KPR(PRNr,"J"))
 . Quit:$E(JNode)'="J"
 . Set B(1)=^KPR(PRNr,JNode)
 . Set KortTxt=$P(^KPR(PRNr,0),D)
 . For  Do ADD^vhLock("^KPR(PRNr)") Quit:%TC  Do LDISP^vhLock("^KPR(PRNr)","Product")
 . Do:SchGrOrde'="" MODFIELD^PRODUKT(PRNr,210,SchGrOrde),MODFIELD^PRODUKT(PRNr,214,"")
 . Do:SchKatPrHand'="" MODFIELD^PRODUKT(PRNr,218,$S(SchKatPrHand="Z":"",1:SchKatPrHand)),MODFIELD^PRODUKT(PRNr,215,"")
 . Do:SchKatPr'="" MODFIELD^PRODUKT(PRNr,219,$S(SchKatPr="Z":"",1:SchKatPr)),MODFIELD^PRODUKT(PRNr,216,"")
 . Do:CorFaktCifPPL'=""
 ..  Do MODFIELD^PRODUKT(PRNr,"J108",CorFaktCifPPL,0),PUTLOG^PRODUKT(PRNr,,$P(B(1),D,8),CorFaktCifPPL,"Corr CifPPL (S>H)")
 ..  Do MODFIELD^PRODUKT(PRNr,326,"",0),PUTLOG^PRODUKT(PRNr,,CorFaktCifPPL,"","S-Corr CifPPL (S>H)")
 . If SchMunt="",SchPPL="",SchKortP="",SchVorkP="",SchDBP="",SchCifP=""
 . Else  Do
 ..  Do:SchMunt'=""
 ...   Do MODFIELD^PRODUKT(PRNr,"J117",SchMunt,0),PUTLOG^PRODUKT(PRNr,,$P(B(1),D,17),SchMunt,"Munt (S>H)")
 ...   Do MODFIELD^PRODUKT(PRNr,203,"",0),PUTLOG^PRODUKT(PRNr,SchMunt,"","S-Munt (S>H)")
 ..  Do:SchPPL'=""
 ...   Do MODFIELD^PRODUKT(PRNr,"J119",SchPPL,0),PUTLOG^PRODUKT(PRNr,,$P(B(1),D,19),SchPPL,"PPL (S>H)")
 ...   Do MODFIELD^PRODUKT(PRNr,303,"",0),PUTLOG^PRODUKT(PRNr,,SchPPL,"","S-PPL (S>H)")
 ..  Do:SchKortP'=""
 ...   Do MODFIELD^PRODUKT(PRNr,"J109",SchKortP,0),PUTLOG^PRODUKT(PRNr,,$P(B(1),D,9),SchKortP,"Kort% (S>H)")
 ...   Do MODFIELD^PRODUKT(PRNr,304,"",0),PUTLOG^PRODUKT(PRNr,,SchKortP,"","S-Kort% (S>H)")
 ..  Do:SchVorkP'=""
 ...   Do MODFIELD^PRODUKT(PRNr,"J127",SchVorkP,0),PUTLOG^PRODUKT(PRNr,,$P(B(1),D,27),SchVorkP,"Vork% (S>H)")
 ...   Do MODFIELD^PRODUKT(PRNr,305,"",0),PUTLOG^PRODUKT(PRNr,,SchVorkP,"","S-Vork% (S>H)")
 ..  Do:SchDBP'=""
 ...   Do MODFIELD^PRODUKT(PRNr,"J124",SchDBP,0),PUTLOG^PRODUKT(PRNr,,$P(B(1),D,24),SchDBP,"DB% (S>H)")
 ...   Do MODFIELD^PRODUKT(PRNr,306,"",0),PUTLOG^PRODUKT(PRNr,,SchDBP,"","S-DB% (S>H)")
 ..  Do:SchCifP'=""
 ...   Do MODFIELD^PRODUKT(PRNr,"J121",SchCifP,0),PUTLOG^PRODUKT(PRNr,,$P(B(1),D,21),SchCifP,"Cif% (S>H)")
 ...   Do MODFIELD^PRODUKT(PRNr,307,"",0),PUTLOG^PRODUKT(PRNr,,SchCifP,"","S-Cif% (S>H)")
 .. Do RECALC^PRODUKT2(PRNr)
 . Do REMOVE^vhLock("^KPR(PRNr)")
 Quit 1
 
DISPPROD(PRNr,ModCnt,Cnt) ; tussentijds tonen van het product
 Quit:(Cnt#100'=0)
 Set FP=2123
 Set KortTxt=$P(^KPR(PRNr,0),D)
 Write @F,@F2,ModCnt," / ",Cnt," - ",PRNr," : ",KortTxt
 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
 ;