PVBURB ;NEW PROGRAM [ 03/19/98  11:05 AM ]
 Set D="\"
 Set PRNr=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
 .Quit:'$D(^KPR(PRNr,"J5810"))
 .Quit:$E($P(^KPR(PRNr,0),D,1),1,4)'="D881"
 .; Old English
 .Lock +^KPR(PRNr)
 .Do DELIND^PRODUKT2(PRNr)
 .Set KT=$P(^KPR(PRNr,0),D,1)
 .Set LTN1=$P(^KPR(PRNr,0),D,2)
 .Set LTF1=$P(^KPR(PRNr,1),D,22)
 .Set LTL=$P(^KPR(PRNr,4),D,1)
 .Set LRef=$P(^KPR(PRNr,"J5810"),D,3)
 .zw KT,LTN1,LTF1,LTL,LRef
 .S $E(KT,2,4)=800
 .Set LTN1=$$REPLACE^vhRtn1(LTN1,"Old English","Reeks 800")
 .Set LTF1=$$REPLACE^vhRtn1(LTF1,"Old English","Serie 800")
 .Set LTL=$$REPLACE^vhRtn1(LTL,"Old English 881","Accessory 800")
 .Set $E(LRef,1,3)=800
 .zw KT,LTN1,LTF1,LTL,LRef
 .If $$EXISTKT^PRODUKT2(KT,PRNr) W *7,"Bestaat reeds" r K Quit
 .Set $P(^KPR(PRNr,0),D,1)=KT
 .Set $P(^KPR(PRNr,0),D,2)=LTN1
 .Set $P(^KPR(PRNr,1),D,22)=LTF1
 .Set $P(^KPR(PRNr,4),D,1)=LTL
 .Set $P(^KPR(PRNr,"J5810"),D,3)=LRef
 .Do BLDIND^PRODUKT2(PRNr)
 .Lock -^KPR(PRNr)
 Quit