KPOSW2 ;Stock rotatie en stock waarde per subgroep [ 11/08/2003   8:40 PM ]
 Do INIT^vhTERMINA
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Do BLDCONTR^Stat.Product.StockWaarde
 Set PRNr=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
 .Do FETCHPR^UTILI(PRNr,"PRec")
 .Set Klas=$P(PRec("I"),D,2)
 .Set Rec=$G(^HULP(%J,Klas))
 .Set GemStock=$P($P(PRec(1),D,24),"#",2)
 .Set GemWVK=$P($P(PRec(1),D,21),"#",2)+$P($P(PRec(1),D,21),"#")
 .Set CifPPL=$P(PRec("J"),D,23)
 .Set Type=$P(PRec(1),D,20) ; Stock
 .Set:'Type Type=2 ; NIET-Stock
 .Set:Type=2&$D(ContrInd(PRNr)) Type=3 ; Contract
 .Set $P(Rec,D,Type*5-4)=$P(Rec,D,Type*5-4)+(GemStock*CifPPL)
 .Set $P(Rec,D,Type*5-3)=$P(Rec,D,Type*5-3)+(GemWVK*48*CifPPL)
 .Set ^HULP(%J,Klas)=Rec
TRANS Set Klas=""
 U 0:(::::4096)
 Write "TRANSFERT"
 Read K
 For  Set Klas=$O(^HULP(%J,Klas)) Quit:Klas=""  Do
 .Set Rec=^(Klas)
 .Write $$DISPLS^KLASS(Klas)
 .For I=1,2,6,7,11,12 Write $C(9),$J($P(Rec,D,I),0,0)
 .Write !
 Write "~~~"
 Quit