KSCHADVP ;Verwijderen schaduwgegevens produkten ;KSCHADV; [ 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=202
 Write @F,@F4,K,@F5
 Write !!?2,"PRODUKTENBESTAND:",!?2,"Voor die produkten welke schadwgegevens bevatten:"
 Write !?2,"Alle schaduwgegevens verdwijnen."
 Set LEVNr=$$SELECT^LEVER(1),FP=2201
 Write @F,@F1,"  LEVERANCIER : ",$S(LEVNr:LEVNr_" "_$P(^KLE(^KL1(LEVNr),0),D,2),1:"ALLE")
 Set R="K\23\3\V[] = VERWIJDEREN SCHADUWGEGEVENS   -[] = hernemen\\1\\""-V""[K&$L(K)"
 Do R0 Do:K'="-"
 . Set R="K\24\3\V[] = DEFINITIEF VERWIJDEREN SCHADUWGEGEVENS   -[] = hernemen\\1\\""-V""[K&$L(K)"
 . Do R0
 . Quit:K="-"
 . Set FP=1903
 . Write @F,@F1,"VERWIJDEREN SCHADUWGEGEVENS PRODUKTEN"
 . For  Do ADD^vhLock("^KPR") Quit:%TC  Do LDISP^vhLock("^KPR","Productenbestand")
 . ;Set FP=2103
 . ;Write @F,"GROOTTEORDE"
 . ;Do GRORDE
 . Set FP=2103
 . Write @F,"PRODUKT     :"
 . Set PRNr=0
 . For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
 .. If LEVNr,'$D(^KPR(PRNr,"J"_LEVNr)) Quit
 .. Do ONEPROD(PRNr)
 Quit
 ;
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
 ;
ONEPROD(PRNr)
 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=$P(R,D,3),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=""
 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),FP=2117
 . Write @F,@F2,KortTxt
 . For  Do ADD^vhLock("^KPR(PRNr)") Quit:%TC  Do LDISP^vhLock("^KPR(PRNr)","Product")
 . Do:SchGrOrde'="" MODFIELD^PRODUKT(PRNr,214,"")
 . Do:SchKatPrHand'="" MODFIELD^PRODUKT(PRNr,215,"")
 . Do:SchKatPr'="" MODFIELD^PRODUKT(PRNr,216,"")
 . Do:CorFaktCifPPL'=""
 ..  Do MODFIELD^PRODUKT(PRNr,326,"",0),PUTLOG^PRODUKT(PRNr,,CorFaktCifPPL,"","S-Corr CifPPL (Verw)")
 . If SchMunt="",SchPPL="",SchKortP="",SchVorkP="",SchDBP="",SchCifP=""
 . Else  Do
 ..  Do:SchMunt'=""
 ...   Do MODFIELD^PRODUKT(PRNr,203,"",0),PUTLOG^PRODUKT(PRNr,,SchMunt,"","S-Munt (Verw)")
 ..  Do:SchPPL'=""
 ...   Do MODFIELD^PRODUKT(PRNr,303,"",0),PUTLOG^PRODUKT(PRNr,,SchPPL,"","S-PPL (Verw)")
 ..  Do:SchKortP'=""
 ...   Do MODFIELD^PRODUKT(PRNr,304,"",0),PUTLOG^PRODUKT(PRNr,,SchKortP,"","S-Kort% (Verw)")
 ..  Do:SchVorkP'=""
 ...   Do MODFIELD^PRODUKT(PRNr,305,"",0),PUTLOG^PRODUKT(PRNr,,SchVorkP,"","S-Vork% (Verw)")
 ..  Do:SchDBP'=""
 ...   Do MODFIELD^PRODUKT(PRNr,306,"",0),PUTLOG^PRODUKT(PRNr,,SchDBP,"","S-DB% (Verw)")
 ..  Do:SchCifP'=""
 ...   Do MODFIELD^PRODUKT(PRNr,307,"",0),PUTLOG^PRODUKT(PRNr,,SchCifP,"","S-Cif% (Verw)")
 . Do REMOVE^vhLock("^KPR(PRNr)")
 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
 ;