PRStockSan
STOCKSAN ; Stock lijst voor stock sanering
 Do BLDCONTR^KPOSW
 Set EindDat=$$CALCDATE^vhDTyp($H,"M",-1)
 Set Begin=$$EXTDATE^vhDTyp($$CALCDATE^vhDTyp(EindDat,"M",-11),"DM4")_" "
 Set Eind=$$EXTDATE^vhDTyp(EindDat,"DM4")_" "
 Write @F11,@F1
 Write @FMTI,"Stocksanering exportlijst"," - ",QN," ",@FMTi
 Set FP=1801
 Write @F,"Periode van ",Begin," tot ",Eind
 Set FP=2001
 Write @F
 
 Set Dev=0
 Set Dev=$$OPEN^vhDEV(,"Stocksanering.txt","W","T")
 Use Dev
 Set PRNr=0
 Write $TR("IdentNr;KortTekst;HG;GR;SG;SortKey;LevNm;S/N;Kind6;GemWVK;GemFysSt;Rot;Telb;#Klant;JaarVkp;FysSt;TheoSt;PraktSt;LevTrm;IsKS;ABC;CiffPPL;DB%;Vork%;GenType;ProductGroep;kind/moeder;mime;omzet;ppl;schaduwppl;grootvpk;kleinvpk;oms 1;oms 2;oms 3;LinkType",";",$C(9)),!
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do  ;Quit:PRNr>2000 
 .Do FETCHPR^UTILI(PRNr,"Rec")
 .;If ($P(Rec(0),D,3)?4.7N)&&($P(Rec("J"),D,1)="6332")&&'$P(Rec(0),D,14) Quit ; geen afgeleide prod van HALUX en zonder stock
 .Write $P(Rec(2),D,25),$C(9)
 .Write $P(Rec(0),D,1),$C(9)
 .Write $$DISPLS^KLASS($P(Rec("I"),D,1)),$C(9)
 .Write $$DISPLS^KLASS($P(Rec("I"),D,2)),$C(9)
 .Write $$DISPLS^KLASS($P(Rec("I"),D,3)),$C(9)
 .Write $$SORTKEY^PRODUKT(PRNr),$C(9)
 .Set LEVNr=$P(Rec("J"),D,1)
 .Set LevNm=$S($D(^KL1(LEVNr)):$P($G(^KLE(^KL1(LEVNr),0)),D,2),1:"")
 .Write LevNm,$C(9)
 .Write $S($D(ContrInd(PRNr)):"C",$P(Rec(1),D,20):"S",1:"N"),$C(9) ; Is stock
 .Set ProdTyp=""
 .Set:$E($P(^KPR(PRNr,2),D,25))=6 ProdTyp="K"
 .Write ProdTyp,$C(9)
 .Write $P($P(Rec(1),D,21),"#")+$P($P(Rec(1),D,21),"#",2),$C(9) ; gewogen gem. weekverkoop
 .Write $TR($P($P(Rec(1),D,24),"#",2),".",","),$C(9) ; gem. fys stock
 .Write $TR($P($P(Rec(1),D,24),"#",1),".",","),$C(9) ; rotatie
 .Write $P(Rec(1),D,7),$C(9) ; Telbaar
 .Write $O(^AKANAL(PRNr,""),-1),$C(9) ;#klanten
 .Write $TR($$PROD^STAT(PRNr,0,Begin,Eind,1,1),".",","),$C(9) ; Aantal stuks
 .Write $TR($P(Rec(0),D,14),".",","),$C(9) ; Fys stock
 .Write $TR($$GETSTOCK^PRODUKT4(PRNr,"T"),".",","),$C(9)
 .Write $TR($$GETSTOCK^PRODUKT4(PRNr,"P"),".",","),$C(9)
 .Write $P(Rec("J"),D,7),$C(9)
 .Write $P(Rec(3),D,3),$C(9) ; KS prijslijst
 .;Write $P(Rec("J"),D,11),$C(9) ; KS kleinvp
 .;Write $P(Rec("J"),D,12),$C(9) ; KS groot
 .Write $P($P(Rec(0),D,8),"#",1),$C(9) ; ABC
 .Write $TR($P(Rec("J"),D,23),".",","),$C(9) ; CiffPPL
 .Write $TR($P(Rec("J"),D,24),".",",")/100,$C(9) ; DB%
 .Write $TR($P(Rec("J"),D,27),".",",")/100,$C(9) ; Vork%
 .Set oProduct=##class(Prod.Product).%OpenId(PRNr)
 .Write oProduct.GetPropViaNr(PRNr,"GENTYP"),$C(9)
 .Write oProduct.GetPropViaNr(PRNr,"ProductGroep"),$C(9)
 .Set KM=oProduct.GetPropViaNr(PRNr,"KindMoeder")
 .Set KM=$S(oProduct.GenerischeRoutine?4.7N:"A",$L(oProduct.GenerischeRoutine):"G",1:KM)
 .Write KM,$C(9)
 .Write oProduct.Prijs.MinimumBestelhoeveelheid,$C(9)
 .Write $TR($$PROD^STAT(PRNr,0,Begin,Eind,3,0),".",","),$C(9)
 .Write $TR(oProduct.Prijs.PPL,".",","),$C(9)
 .Write $TR(oProduct.Schaduw.PPL,".",","),$C(9)
 .Write oProduct.Prijs.GrootVerpakking,$C(9)
 .Write oProduct.Prijs.KleinVerpakking,$C(9)
 .Write oProduct.Tekst.OmschrijvingN1,$C(9)
 .Write oProduct.Tekst.OmschrijvingN2,$C(9)
 .Write oProduct.Tekst.OmschrijvingN3,$C(9)
 .Write oProduct.LinkType,$C(9)
 .Write !
 Do CLOSE^vhDEV(Dev)
 Quit