PRLINKS ;Wijzigen van fys.stock van samengestelde producten [ 06/29/2003  8:09 PM ]
 Do VERWERK($$SELECT^PRODUKT6())
 Q
VERWERK(DispPRNr,Raadpl) 
 New List,LD
 Set Raadpl=$G(Raadpl)
 Do:Raadpl STORE^vhTERMINA()
 Do INIT,HOOFDING
 If $G(DispPRNr)?4.7N,'$$CHECK(DispPRNr) Do WRONG(DispPRNr) Quit
 If $G(DispPRNr)'?4.7N Set DispPRNr=$$SELECT
 Quit:'DispPRNr
 Do FETCH(DispPRNr),WRITE
 Do COMMAND
 Do:Raadpl REFRESH^vhTERMINA()
 Quit
 
COMMAND New OldPRNr
 For  Do  Quit:Input="-"  Quit:Raadpl&$L(Input)
 .Set OldPRNr=DispPRNr
 .Set Input=$$SCROLL^vhLIST(.LD)
 .Set MPRNr=$P($G(List(LD("SELECT"))),D,1)
 .Set KPRNr=$P($G(List(LD("SELECT"))),D,10)
 .If Input="COM" Set Input="" Do CALL^vhMenu("PRLINKS")
 .Quit:Input=""
 .Quit:Input="-"
 .Do EXEC^vhMenu("PRLINKS",.Input)
 .If Raadpl,$L(Input) Quit
 .If DispPRNr'?4.7N Set Input="-" Quit
 .If OldPRNr'=DispPRNr Do INIT,HOOFDING,FETCH(DispPRNr),WRITE
 Quit
 
INIT Do INIT^vhLIST("PRLINKS","LIST",.LD)
 Quit
 
HOOFDING 
 Do DISPLAY^vhScherm("PRLINKS")
 Quit
 
SELECT() New PRNr
 For  Do  Quit:PRNr'?4.7N  Quit:$$CHECK(PRNr)
 .Set PRNr=$$SELECT^PRODUKT6()
 Quit PRNr
 
NEXT(PRNr,Dir) 
 For  Do  Quit:PRNr'?4.7N  Quit:$D(^PRLINK("D",PRNr))  ; Alleen moeders
 .Set PRNr=$$NEXT^PRODUKT("K",PRNr,Dir,1)
 Quit PRNr
 
CHECK(PRNr,Optie) 
 New List,Check
 ;Optie = "" ; Test kind of moeder
 ;      = "M" ; Test of moeder
 ;      = "K" ; Test of kind
 ;      = "V" ; Verschil in fys.stock qty's
 If $G(Optie)="",'$D(^PRLINK("D",PRNr)),'$D(^PRLINK("IKM",PRNr)) Quit 0
 If $G(Optie)="" Quit 1 ; Kind of moeder
 If Optie["M",'$D(^PRLINK("D",PRNr)) Quit 0 ; Geen moeder
 If Optie["K",'$D(^PRLINK("IKM",PRNr)) Quit 0 ; Geen kind
 If Optie'["V" Quit 1
 Do FETCH(PRNr)
 Set Check=1
 For I=1:1:$O(List(""),-1) Do  Quit:'Check
 .Quit:$P(List(I),D)?4.7N
 .Quit:$P(List(I),D,2)=""
 .Set Check=$P(List(I),D,2)=$P(List(I),D,11)
 Quit
 
WRONG(PRNr) 
 New X
 Set X=$$^vhTXTPOP("PRLINKS","WRONG",,$P(^KPR(PRNr,0),D))
 Quit
 
WRITE Do WRITE^vhLIST(.LD)
 Quit
 
FETCH(BasePRNr) 
 New MList,SList,KFysSom,KPRNr,MPRNr,Cnt,Base,SortKey,FysSt,Faktor
 New KT,MaxQty,MinQty,MSom,MFysSt
 Set:$D(^PRLINK("IKM",BasePRNr)) BasePRNr=$O(^PRLINK("IKM",BasePRNr,"")) ; Met een moeder vertrekken
 Kill List
 Do SELKIND(BasePRNr)
 ; Sorteren
 Set MPRNr=""
 For  Set MPRNr=$O(MList(MPRNr)) Quit:MPRNr=""  Do 
 .Set SList(MList(MPRNr),$$SORTKEY^PRODUKT(MPRNr))=MPRNr
 .Set KPRNr=""
 .Set FysSt=$P(^KPR(MPRNr,0),D,14)
 .For  Set KPRNr=$O(^PRLINK("D",MPRNr,KPRNr)) Quit:KPRNr=""  Do
 ..Set Faktor=$P(^PRLINK("D",MPRNr,KPRNr),D)
 ..Set KFysSom(KPRNr)=$G(KFysSom(KPRNr))+(FysSt*Faktor)
 ; Aanmaken lijst : moeders en kinderen naast elkaar
 Set (MList,SortKey)=""
 Set Cnt=0
 For  Set MList=$O(SList(MList)) Quit:MList=""  Do
 .Set (Cnt,Base)=$O(List(""),-1)
 .Set MSom=0
 .;Moeders
 .For  Set SortKey=$O(SList(MList,SortKey)) Quit:SortKey=""  Do
 ..Set MPRNr=SList(MList,SortKey)
 ..Set KT=$P(^KPR(MPRNr,0),D)
 ..Set FysSt=$P(^KPR(MPRNr,0),D,14)
 ..Set MSom=MSom+FysSt
 ..Set Cnt=Cnt+1
 ..Set $P(List(Cnt),D,1)=MPRNr
 ..Set $P(List(Cnt),D,2)=KT
 ..Set $P(List(Cnt),D,3)=FysSt
 .;Kinderen
 .Set Cnt=Base
 .Set MinQty=9999999
 .Set MaxQty=-1
 .For I=1:1:$L(MList,D) Do
 ..Set KPRNr=$P($P(MList,D,I),U)
 ..Set Faktor=$P($P(MList,D,I),U,2)
 ..Set KT=$P(^KPR(KPRNr,0),D)
 ..Set FysSt=$P(^KPR(KPRNr,0),D,14)
 ..Set MFysSt=FysSt/Faktor
 ..Set:MFysSt<MinQty MinQty=MFysSt
 ..Set:MFysSt>MaxQty MaxQty=MFysSt
 ..Set Cnt=Cnt+1
 ..Set $P(List(Cnt),D,10)=KPRNr
 ..Set $P(List(Cnt),D,11)=KT
 ..Set $P(List(Cnt),D,12)=FysSt
 ..Set $P(List(Cnt),D,13)=Faktor
 ..Set $P(List(Cnt),D,14)=MFysSt
 ..Set $P(List(Cnt),D,15)=KFysSom(KPRNr)
 .;Totaal en separator
 .Set Cnt=$O(List(""),-1)+1
 .Set $P(List(Cnt),D,2)="Totaal (som)"
 .Set $P(List(Cnt),D,3)=MSom
 .Set $P(List(Cnt),D,11)="Min. qty"
 .Set $P(List(Cnt),D,12)=MinQty
 .Set List(Cnt+1)="&S" ; Separator
 Kill List(Cnt+1)
 Quit
 
SELKIND(MPRNr)  ; Recursie om alle moeders van alle kinderen op te sporen
 New MKind,KPRNr,M2PRNr,KT
 If $E($P(^KPR(MPRNr,0),D,1),1,2)="OL" Quit  ; Tijdelijke niet voor OL produ PV 30-6-03
 Quit:$D(MList(MPRNr))
 Set MList(MPRNr)=""
 Set KPRNr=""
 Set MKind=""
 For  Set KPRNr=$O(^PRLINK("D",MPRNr,KPRNr)) Quit:KPRNr=""  Do
 .Set MKind=MKind_"\"_KPRNr_";"_$P(^PRLINK("D",MPRNr,KPRNr),D)
 .Set M2PRNr=""
 .For  Set M2PRNr=$O(^PRLINK("IKM",KPRNr,M2PRNr)) Quit:M2PRNr=""  Do
 ..Do SELKIND(M2PRNr)
 Set MList(MPRNr)=$E(MKind,2,999)
 Quit
 
MODSTOCK(PRNr) 
 New KT,FysSt,NewSt,AddQty,ModTyp,Reden,Date,X
 Quit:PRNr'?4.7N
 Set KT=$P(^KPR(PRNr,0),D)
 Set FysSt=$P(^KPR(PRNr,0),D,14)
 Set NewSt=$$ASKL^vhINP("PRLINKS","ASKSTOCK")
 Quit:+FysSt=+NewSt!("()-."[NewSt)
 Set AddQty=NewSt-FysSt,ModTyp=3
 Set:AddQty<0 AddQty=-AddQty,ModTyp=4
 Set Date=+$H
 Set Reden="CORR. MOEDER"
 Set X=$$^vhTXTPOP("PRLINKS","MODSTOCK",,KT,FysSt,NewSt)
 Quit:'X
 Do MODSTOCK^PRODUKT4(PRNr,AddQty,,ModTyp,Date,Reden,,,,,,$G(sUser),"A","K")
 Quit
 
RPLPR(PRNr)    
 New X 
 Set X=$$RAADPL^PRODUKT(PRNr,"H",1)
 Do HOOFDING,WRITE
 Quit
 
RAADPL(PRNr,RPLPR) 
 Set RPLPR=$G(RPLPR)
 Do VERWERK(PRNr,1)
 Set:RPLPR VTB=$G(U4),SW2=0,R=Input
 Quit