PRBALST ;Balansdatum i.v.m. stock ;[ 10/12/2001   4:09 PM ]
 ;
 Do INIT^vhTERMINA
 Set %J=$$%J^vhRtn1()
 Do EDIT^vhScherm("PRBALST") Quit:'%SC
 Set List=""
 For  Set List=$O(List(List)) Quit:List=""  Do
 .Quit:'List(List)
 .If $O(^SD("D","PRBALST"_List,""))'="" Do NIEUW^vhScherm("PRBALST"_List) Quit:'%SC
 .If $O(^SD("D","PRBALST"_List,""))="" Do DISPLAY^vhScherm("PRBALST"_List)
 .Set FP=2201,PRCount=0
 .Write @F,@F1
 .Set FP=2403
 .Write @F,"Produkten verwerkt : ",PRCount
 .Kill ^HULP(%J)
 .Set HoofdGr=""
 .For  Set HoofdGr=$O(^KPH(HoofdGr)) Quit:HoofdGr=""  Do
 ..Set Groep=""
 ..For  Set Groep=$O(^KPH(HoofdGr,Groep)) Quit:Groep=""  Do
 ...Set SubGroep=""
 ...For  Set SubGroep=$O(^KPH(HoofdGr,Groep,SubGroep)) Quit:SubGroep=""  Do
 ....Set CompKort=""
 ....For  Set CompKort=$O(^KPH(HoofdGr,Groep,SubGroep,"  ",CompKort)) Quit:CompKort=""  Do
 .....Set PRNr=^KPH(HoofdGr,Groep,SubGroep,"  ",CompKort)
 .....Set PRCount=PRCount+1
 .....If '(PRCount#100) Set FP=2424 Write @F,PRCount
 .....Do @("LIST"_List_"(PRNr)")
 .Do INIT^PROC("PRBALST"_List,"LD")
 .If $L($G(LD(12))) Xecute LD(12) Set LD(12)=""
 .Set LD(11)=$P(List(List),D,2,3)
 .Do PRINT^OUTPUT(.LD,"")
 Kill ^HULP(%J)
 Quit
 ;
 ; De artikelen die niet meer bewegen
LIST1(PRNr) 
 New I,R,Count,IDNr,KortText,Stock,DatLBew,CifPPL,Hist
 Set R=$O(^KPR(PRNr,"J")) Quit:$E(R)'="J"
 Set R=^KPR(PRNr,R),CifPPL=$P(R,D,23)
 Set R=^KPR(PRNr,0),KortText=$P(R,D),Stock=$P(R,D,14)
 If $L(Value) Quit:'Stock!(CifPPL*Stock'>Value)
 Set Hist=$O(^KPR(PRNr,"Hz"),-1) Quit:$E(Hist)'="H"!(Hist="H")
 Set R=^KPR(PRNr,Hist)
 For I=$L(R,D):-1:1 Quit:$L($P(R,D,I))
 Set R=$E($P(R,D,I),1,6),DatLBew=$E(R,5,6)_"."_$E(R,3,4)_"."_$E(R,1,2)
 Quit:$$INTDATE^vhLib.DataTypes(DatLBew)>Date
 Set R=^KPR(PRNr,2),IDNr=$P(R,D,25),R=IDNr_D_KortText_D_Stock_D_CifPPL_D_(CifPPL*Stock)_D_DatLBew
 Set Count=$O(^HULP(%J,""),-1)+1,^HULP(%J,Count)=R
 Quit
 ;
 ; De xx artikelen met grootste voorraadcorrecties
LIST2(PRNr) 
 New I,H,R,IDNr,KortText,CifPPL,Hist,Stuks,CorStuks,CorValue,Date,Hist
 New FromWeek,ToWeek,Week,GemStVal,WCount
 Set R=$O(^KPR(PRNr,"J")) Quit:$E(R)'="J"
 Set R=^KPR(PRNr,R),CifPPL=$P(R,D,23)
 Set Hist="Hz",(CorStuks,CorValue)=0
 For  Set Hist=$O(^KPR(PRNr,Hist),-1) Quit:$E(Hist)'="H"!(Hist="H")  Do
 .Set H=^KPR(PRNr,Hist)
 .For I=$L(H,D):-1:1 Do
 ..Set R=$P(H,D,I) Quit:R=""  Quit:34'[$E(R,7)
 ..Set Stuks=$E($P(R,"#"),8,99) Set:$E(R,7)=4 Stuks=-Stuks
 ..Set Date=$E(R,5,6)_"."_$E(R,3,4)_"."_$E(R,1,2)
 ..Quit:$$INTDATE^vhLib.DataTypes(Date)>ToDate
 ..Quit:$$INTDATE^vhLib.DataTypes(Date)<FromDate
 ..Set CorStuks=CorStuks+Stuks,CorValue=CorValue+(CifPPL*Stuks)
 Set FromWeek=$TR($$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes(ToDate,"W",-53),"DW4"),"/",".")_" "
 Set ToWeek=$TR($$EXTDATE^vhLib.DataTypes(ToDate,"DW4"),"/",".")
 Set Week=FromWeek,(GemStVal,WCount)=0
 For  Set Week=$O(^KSPW(PRNr,Week)) Quit:Week=""!(Week]ToWeek)  Do
 .Set R=^KSPW(PRNr,Week),GemStVal=GemStVal+($P(R,D,4)*CifPPL),WCount=WCount+1
 If WCount Set GemStVal=GemStVal/WCount
 If CorValue Do
 .Set R=^KPR(PRNr,0),KortText=$P(R,D),R=^KPR(PRNr,2),IDNr=$P(R,D,25)
 .Set R=IDNr_D_KortText_D_CorStuks_D_CorValue_D_GemStVal
 .Set:GemStVal R=R_D_(CorValue/GemStVal*100)
 .Set:CorValue<0 CorValue=-CorValue
 .Set ^HULP(%J,999999999-CorValue)=R
 Quit
 ;
 ; De stockwijzigingen toeleveringen op datum ...
LIST3(PRNr) 
 New I,H,R,Count,IDNr,KortText,TOENr,Stuks,Date,Hist
 Set R=^KPR(PRNr,0),KortText=$P(R,D),R=^KPR(PRNr,2),IDNr=$P(R,D,25)
 Set Hist="Hz"
 For  Set Hist=$O(^KPR(PRNr,Hist),-1) Quit:$E(Hist)'="H"!(Hist="H")  Do
 .Set H=^KPR(PRNr,Hist)
 .For I=$L(H,D):-1:1 Do
 ..Set R=$P(H,D,I) Quit:R=""  Quit:13'[$E(R,7)
 ..Set TOENr=$P(R,"#",3),Stuks=$E($P(R,"#"),8,99)
 ..Set Date=$E(R,5,6)_"."_$E(R,3,4)_"."_$E(R,1,2)
 ..Quit:$$INTDATE^vhLib.DataTypes(Date)>ToDate
 ..Quit:$$INTDATE^vhLib.DataTypes(Date)<FromDate
 ..Set R=IDNr_D_KortText_D_TOENr_D_Date_D_Stuks
 ..Set Count=$O(^HULP(%J,""),-1)+1,^HULP(%J,Count)=R
 ..Set (KortText,IDNr)=""
 Quit
 ;
 ; De stockwijzigingen uitleveringen op datum ...
LIST4(PRNr) 
 New I,H,R,Count,IDNr,KortText,BONNr,Stuks,Date,Hist
 Set R=^KPR(PRNr,0),KortText=$P(R,D),R=^KPR(PRNr,2),IDNr=$P(R,D,25)
 Set Hist="Hz"
 For  Set Hist=$O(^KPR(PRNr,Hist),-1) Quit:$E(Hist)'="H"!(Hist="H")  Do
 .Set H=^KPR(PRNr,Hist)
 .For I=$L(H,D):-1:1 Do
 ..Set R=$P(H,D,I) Quit:R=""  Quit:24'[$E(R,7)
 ..Set BONNr=$P(R,"#",3),Stuks=$E($P(R,"#"),8,99) Quit:BONNr["INV"
 ..Set Date=$E(R,5,6)_"."_$E(R,3,4)_"."_$E(R,1,2)
 ..Quit:$$INTDATE^vhLib.DataTypes(Date)>ToDate
 ..Quit:$$INTDATE^vhLib.DataTypes(Date)<FromDate
 ..Set R=IDNr_D_KortText_D_BONNr_D_Date_D_Stuks
 ..Set Count=$O(^HULP(%J,""),-1)+1,^HULP(%J,Count)=R
 ..Set (KortText,IDNr)=""
 Quit
 ;
 ; In stock op dd-mm-jj en aankoopprijs=0
LIST5(PRNr) 
 New I,R,Count,IDNr,KortText,Stock,DatLBew,Hist
 Set R=$O(^KPR(PRNr,"J")) Quit:$E(R)'="J"
 Set R=^KPR(PRNr,R) Quit:$P(R,D,19)
 Set R=^KPR(PRNr,0),KortText=$P(R,D),Stock=$P(R,D,14) Quit:'Stock
 Set Hist=$O(^KPR(PRNr,"Hz"),-1),R=$S($E(Hist)="H":^KPR(PRNr,Hist),1:"")
 For I=$L(R,D):-1:1 Quit:$L($P(R,D,I))
 Set R=$P(R,D,I),DatLBew=$S($L(R):$E(R,5,6)_"."_$E(R,3,4)_"."_$E(R,1,2),1:"")
 Set R=^KPR(PRNr,2),IDNr=$P(R,D,25),R=IDNr_D_KortText_D_Stock_D_DatLBew
 Set Count=$O(^HULP(%J,""),-1)+1,^HULP(%J,Count)=R
 Quit
 ;
SELPRINT(sFld,X) 
 New Sel,Pos,Titel
 Set Pos=sFld*3+1_";5"
 Set Titel=$P(sScrnDef(sFld),"`",3)
 Set:$E(Titel)'="""" Titel=""""_Titel Set:$E(Titel,$L(Titel))'="""" Titel=Titel_""""
 Xecute "Set Titel="_Titel
 Set $P(List(sFld),D,2)=Titel
 Set Sel(1)="1`Afdrukken",Sel(2)="0`Niet afdrukken"
 Quit $$WILD^vhPOPUP(Pos,"O1-",Titel,.Sel,X)
 ;