CWPRDEL ;Verwijderen produkten Burbidge, Folietec, Polylak en Niegel [ 06/26/2001  2:15 PM ]
 ;
 Kill
 Do INIT^vhTERMINA
 Open 117
 Use 117
 For LEVNr=5810,6092,6267,6428 Set LEVNr(LEVNr)=^KL1(LEVNr)
 Set (PRNr,Count)=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
 .Set LEVNr=$$LEVNR^PRODUKT2(PRNr)
 .Quit:'$D(LEVNr(LEVNr))
 .Set Delete=$$CHECKDEL^PRODUKT2(PRNr,"SOFTUBK")
 .Quit:Delete=""
 .;Quit:$L(Delete)
 .Write !,PRNr,?7,$P(^KPR(PRNr,0),D),?35,Delete
 .Set Count=Count+1
 .;Do DELETE^PRODUKT2(PRNr)
 Write !!,Count,#
 Close 117
 Quit
 ;