ORGASTAT ;NEW PROGRAM [ 04/03/2003  1:25 PM ]
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Do INIT
 Do FETCH()
 Do REFRESH
 For  Do  Quit:Input="-"!(Input="CANC")
 .If DispMode="O" Do
 ..Set Input=$$SCROLL^vhLIST(.LD,,1)
 ..Set LevWk=$S(LD("SELECT"):$P($G(^HULP(%J,"L",LD("SELECT"))),D,1),1:"")
 .If DispMode="D" Do
 ..Set Input=$$SCROLL^vhLIST(.DLD)
 .If Input="COM"  Set Input="" Do CALL^vhMenu("ORGASTAT")
 .Do EXEC^vhMenu("ORGASTAT",.Input)
 Quit
 
INIT Set KLNr=""
 Set SubWk=""
 Set DispMode="O"
 Do INIT^vhLIST("ORGASTAT","OVZ",.LD)
 Quit
 
REFRESH 
 Write @F11,@F1
 Do DISPLAY^vhScherm("ORGASTAT")
 If DispMode="O" Do
 .Do WRITE^vhLIST(.LD)
 If DispMode="D" Do
 .Do WRITE^vhLIST(.DLD)
 Quit
 
FETCH(KLNr) 
 New LevWk,VolgNr,OvzDtl,I,J,RecH,Rec
 Set KLNr=$G(KLNr)
 Set LevWk="",Cnt=0
 Set OvzDtl=$S(KLNr:"D",1:"O")
 Set:$G(Nodes)="" Nodes="OBFP"
 Set LevWk=$O(^ORGASTAT(OvzDtl,LevWk))
 For  Set LevWk=$$CALCDATE^vhDTyp(LevWk,"W",+1,"MD") Do  Quit:$O(^ORGASTAT(OvzDtl,LevWk))=""
 .Set Cnt=Cnt+1
 .Set Rec=""
 .Set $P(Rec,D,1)=LevWk
 .Set:LevWk<$H DefSelect=Cnt
 .Set Node=""
 .For  Set Node=$O(^ORGASTAT(OvzDtl,LevWk,Node)) Quit:Node=""  Do
 ..Set:'KLNr RecH=$G(^ORGASTAT(OvzDtl,LevWk,Node))
 ..Set:KLNr RecH=$G(^ORGASTAT(OvzDtl,LevWk,Node,KLNr))
 ..Quit:RecH=""
 ..Set I=$F(Nodes,Node)-1
 ..For J=1:1:4 Do
 ...Set $P(Rec,D,I*4-3+J)=$P(Rec,D,I*4-3+J)+$P(RecH,D,J)
 ...Set $P(Rec,D,20+J)=$P(Rec,D,20+J)+$P(RecH,D,J)
 .Set ^HULP(%J,"L",Cnt)=Rec
 Set:$G(DefSelect) LD("SELECT")=DefSelect
 Quit
 
STOREREC(Node,RecH,Rec) 
 Quit:RecH=""
 Set I=$F(Nodes,Node)-1
 For J=1:1:4 Set $P(Rec,D,I*4-3+J)=$P(Rec,D,I*4-3+J)+$P(RecH,D,J)
 Quit 
 
SHOWOVZ Set DispMode="O",KLNr=""
 Do FETCH(KLNr)
 Do REFRESH
 Quit
 
SHOWKL If DispMode="D",DLD("SELECT") Do
 .Set KLNr=$P($G(^HULP(%J,"D",DLD("SELECT"))),D,1)
 Else  Do
 .Do FIELD^vhScherm("ORGASTAT","KLANT")
 Set DispMode="O"
 Do FETCH(KLNr)
 Do REFRESH
 Quit
 
SHOWDTL(LevWk) 
 New Rec,I,J,Soort,Node,RecH,SortNr,VolgNr
 Kill DLD
 Do INIT^vhLIST("ORGASTAT","DTL",.DLD)
 Set DispMode="D"
 Kill ^HULP(%J,"D"),^HULP(%J,"T1"),^HULP(%J,"T2")
 Set SortNr=""
 Set Node=""
 For  Set Node=$O(^ORGASTAT("D",LevWk,Node)) Quit:Node=""  Do
 .Set I=$F(Nodes,Node)-1
 .Set KLNr=0
 .For  Set KLNr=$O(^ORGASTAT("D",LevWk,Node,KLNr)) Quit:KLNr=""  Do
 ..Set Rec=$G(^HULP(%J,"T1",KLNr),KLNr)
 ..Set RecH=^ORGASTAT("D",LevWk,Node,KLNr)
 ..For J=1:1:4 Do
 ...Set $P(Rec,D,I*4-3+J)=$P(Rec,D,I*4-3+J)+$P(RecH,D,J)
 ...Set $P(Rec,D,20+J)=$P(Rec,D,20+J)+$P(RecH,D,J)
 ..Set ^HULP(%J,"T1",KLNr)=Rec
 ; Sorteren volgens omzet
 Set KLNr=""
 For  Set KLNr=$O(^HULP(%J,"T1",KLNr)) Quit:KLNr=""  Do
 .Set Rec=^HULP(%J,"T1",KLNr)
 .Set ^HULP(%J,"T2",-$P(Rec,D,23),KLNr)=Rec
 ; Flat list
 Set SortNr=""
 Set (Key,KLNr)=""
 For  Set Key=$O(^HULP(%J,"T2",Key)) Quit:Key=""  Do
 .For  Set KLNr=$O(^HULP(%J,"T2",Key,KLNr)) Quit:KLNr=""  Do
 ..Set SortNr=SortNr+1
 ..Set ^HULP(%J,"D",SortNr)=^HULP(%J,"T2",Key,KLNr)
 Kill ^HULP(%J,"T1"),^HULP(%J,"T2")
 Do REFRESH
 Quit
        
RPLKL If DispMode="D" New KLNr Do
 .Quit:'DLD("SELECT")
 .Set KLNr=$P($G(^HULP(%J,"D",DLD("SELECT"))),D,1)
 Quit:'$G(KLNr)
 New Actie
 Set Actie=$$RAADPL^KLANT(KLNr,"O")
 Do REFRESH
 Quit
 
RPLPR New PRNr,Actie
 Quit:DispMode'="D"
 Quit:'DLD("SELECT")
 Set PRNr=$P($G(^HULP(%J,"D",DLD("SELECT"))),D,2)
 Set Actie=$$RAADPL^PRODUKT(PRNr,"O")
 Do REFRESH
 Quit
 ;--------------------------------------
NIGHT S $ZT="^cA406",Q="K" D ^cA604
 Do BUILD("OBFP",,0) 
 Do COPYHIST
 Quit
 
COPYHIST Set HistMax=$O(^ORGASTAT("H",""),-1)
 Set Hist=""
 For  Set Hist=$O(^ORGASTAT("H",Hist)) Quit:Hist=""  Do
 . Kill:Hist<(HistMax-10) ^ORGASTAT("H",Hist)
 Set HistMax=HistMax+1
 Set ^ORGASTAT("H",HistMax)=$H
 For Key="D","O","P" Do
 . Merge ^ORGASTAT("H",HistMax,Key)=^ORGASTAT(Key)
 Quit
 
JOB Job NIGHT^ORGASTAT
 Do WARN^vhTXTPOP("Achtergrond opdracht gestart~Duurtijd ongeveer 15 min.")
 Quit
 
ISJOB() Lock +^ORGASTAT:0 Else  Do  Quit 1
 .Do WARN^vhTXTPOP("Ophalen van de gegevens is NOG STEEDS bezig","Achtergrond opdracht")
 Lock -^ORGASTAT
 ;Do WARN^vhTXTPOP("Niet bezig","Achtergrond opdracht")
 Quit 0
 
REBUILD(ItemList)      
 Do BUILD(ItemList,,1)
 Quit
 
BUILD(ItemList,VanWeek,Display)        
 ; Optioneel : Vanweek : oude gegevens blijven bestaan
 ; Optioneel : Display : met tussentijdse gegeven display
 Lock +^ORGASTAT:1 Else  Do:$G(Display)  Quit
 .Set FP=2301 Write @F,@F1,!,"Databank gelockt, geen nieuwe gegevens opgehaald" Hang 5
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Set FP=2301 Write:$G(Display) @F,@F1,!,"Verwerken orders en bons"
 If ItemList["O"!(ItemList["B") Do CLEAN("O"),CLEAN("B"),FETCHOU("OL")
 Kill ^HULP(%J) ; Onthouden van de ordernrs is verschillend met deze van de fakturen (roundrobin van het ordernr)
 Write:$G(Display) @F,@F1,!,"Verwerken fakturen"
 If ItemList["F" Do CLEAN("F",$G(VanWeek)),FETCHFA("F",$NA(^KFA),"OL",$G(VanWeek))
 Write:$G(Display) @F,@F1,!,"Verwerken proforma"
 If ItemList["P" Do CLEAN("P",$G(VanWeek)),FETCHFA("P",$NA(^KFAP),"OL",$G(VanWeek))
 Write:$G(Display) @F,@F1
 Kill ^HULP(%J)
 Lock -^ORGASTAT
 Quit
 
CLEAN(Node,VanWeek)          
 Set Wk=""
 For  Set Wk=$O(^ORGASTAT("O",Wk)) Quit:Wk=""  Do
 .If $G(VanWeek) Quit:VanWeek>Wk  ; Oude laten staan
 .Kill ^ORGASTAT("O",Wk,Node)
 .Kill ^ORGASTAT("D",Wk,Node)
 .Kill ^ORGASTAT("P",Wk,Node)
 Quit 
 
STORE(Node,PRNr,KLNr,FAKNr,ULNr,ORDNr,NewOrd,LevWk,Qty,Omzet,Marge) 
 New Key
 Set FAKNr=$G(FAKNr)
 Set ULNr=$G(ULNr)
 Set ORDNr=$G(ORDNr)
 Set Marge=$G(Marge)
 If Marge="" Do
 . Set Key=$O(^KPR(PRNr,"J"))
 . Set Marge=Omzet-($P(^KPR(PRNr,Key),D,23)*Qty) ; Marge=Omzet-Aankoop
 If '$D(NewOrd) Do
 . Set NewOrd=$S('ORDNr:1,'$D(^HULP(%J,ORDNr)):1,1:0)
 . Set:ORDNr ^HULP(%J,ORDNr)=""
 Do CUMUL(Node,NewOrd,Omzet,Marge,0)
 Do CUMUL(Node,NewOrd,Omzet,Marge,KLNr)
 Do DTL(Node,KLNr,PRNr,FAKNr,ULNr,ORDNr,NewOrd,LevWk,Qty,Omzet,Marge)
 Quit
 
CUMUL(Node,NewOrd,Omzet,Marge,KLNr)         
 New Rec
 Set:'KLNr Rec=$G(^ORGASTAT("O",LevWk,Node))
 Set:KLNr Rec=$G(^ORGASTAT("D",LevWk,Node,KLNr))
 Set $P(Rec,D,1)=$P(Rec,D,1)+NewOrd ; #orders
 Set $P(Rec,D,2)=$P(Rec,D,2)+1 ; #orderlijnen
 Set $P(Rec,D,3)=$P(Rec,D,3)+Omzet
 Set $P(Rec,D,4)=$P(Rec,D,4)+Marge
 Set:'KLNr ^ORGASTAT("O",LevWk,Node)=Rec
 Set:KLNr ^ORGASTAT("D",LevWk,Node,KLNr)=Rec
 Quit
 
DTL(Node,KLNr,PRNr,FAKNr,BONNr,ORDNr,NewOrd,LevWk,Qty,Omzet,Marge)   
 New Rec,VolgNr
 Set Rec=PRNr_D_FAKNr_D_ULNr_D_ORDNr_D_NewOrd_D_Qty_D_Omzet_D_Marge
 Set VolgNr=$O(^ORGASTAT("P",LevWk,Node,KLNr,""),-1)+1
 Set ^ORGASTAT("P",LevWk,Node,KLNr,VolgNr)=Rec
 Quit
 
FETCHOU(HGSelect) 
 Set (HG,GR,SG,Merk,KortT)=""
 For  Set HG=$O(^KPH(HG)) Quit:HG=""  Do:HG[HGSelect
 . For  Set GR=$O(^KPH(HG,GR)) Quit:GR=""  Do
 .. For  Set SG=$O(^KPH(HG,GR,SG)) Quit:SG=""  Do
 ... For  Set Merk=$O(^KPH(HG,GR,SG,Merk)) Quit:Merk=""  Do
 .... For  Set KortT=$O(^KPH(HG,GR,SG,Merk,KortT)) Quit:KortT=""  Do
 ..... Set PRNr=$P(^KPH(HG,GR,SG,Merk,KortT),D)
 ..... Quit:'$$CHKTELB(HG_D_GR_D_SG)
 ..... Do FETCHORD(PRNr)
 ..... Do FETCHUL(PRNr)
 Quit
 
FETCHORD(PRNr)     
 New Batches,ORDNr,OLUNr,KLNr,Rec,Qty,Tot,TOENr,TLNr,Tot,Munt,LevWk,ProdWk
 Set ORDNr="",OLUNr=""
 For  Set ORDNr=$O(^ORD("IP",PRNr,ORDNr)) Quit:ORDNr=""  Do
 . For  Set OLUNr=$O(^ORD("IP",PRNr,ORDNr,OLUNr)) Quit:OLUNr=""  Do
 ..  Set OLNr=^(OLUNr)
 ..  Set KLNr=$P(^KO1(ORDNr,"F"),D)
 ..  Set Rec=^KOD(KLNr,"F",ORDNr,OLNr)
 ..  Set Qty=$P(Rec,D,3)
 ..  Set Tot=$P(Rec,D,16)
 ..  Set Munt=$$MUNTPAR^vhRtn1($P(Rec,D,22))
 ..  Set LevWk=$S($P(Rec,D,25)?5N:$P(Rec,D,25),1:$$INTDATE^vhDTyp($P(Rec,D,25),"DW"))
 ..  Set:$P(^KOD(KLNr,"F",ORDNr,1),D,25)="C" LevWk=$S($P(Rec,D,29)?5N:$P(Rec,D,29),1:$$INTDATE^vhDTyp($P(Rec,D,29),"DW")) ; Contract
 ..  Do STORE("O",PRNr,KLNr,,,ORDNr,,LevWk,Qty,Tot/Munt)
 Quit
 
FETCHUL(PRNr)      ; Leveringsbons
 New BONNr,OLNr,Qty,Rec,Tot,Munt,LevWk,Key,CiffPPL
 Set BONNr="",OLNr=""
 For  Set BONNr=$O(^KUP(PRNr,BONNr)) Quit:BONNr=""  Do
 . For  Set OLNr=$O(^KUP(PRNr,BONNr,OLNr)) Quit:OLNr=""  Do
 ..  Set KLNr=$P(^KUP(PRNr,BONNr,OLNr),D)
 ..  Set LevWk=$$INTDATE^vhDTyp($P(^KUL(KLNr,"F",BONNr,1),D,2))
 ..  Set LevWk=$$CALCDATE^vhDTyp(LevWk,"W","MD")
 ..  Set Rec=$G(^KUL(KLNr,"F",BONNr,OLNr))
 ..  Quit:Rec=""
 ..  Set ORDNr=$$GETORD(KLNr,BONNr,OLNr)
 ..  Set Qty=$P(Rec,D,3)
 ..  Set Tot=$P(Rec,D,16)
 ..  Set Munt=$$MUNTPAR^vhRtn1($P(Rec,D,22))
 ..  Do STORE("B",PRNr,KLNr,,BONNr,ORDNr,,LevWk,Qty,Tot/Munt)
 Quit
 
GETORD(KLNr,BONNr,OLNr) 
 ; Ophalen van het ordernr in de leveringsbon
 New ORDNr
 Set ORDNr=""
 For  Set OLNr=$O(^KUL(KLNr,"F",BONNr,OLNr),-1) Quit:OLNr<100  Do  Quit:ORDNr
 .Set:$P(^KUL(KLNr,"F",BONNr,OLNr),D,17)="KF5" ORDNr=+$P(^KUL(KLNr,"F",BONNr,OLNr),D,5)
 If 'ORDNr Do
 .Set OLNr=101
 .Set:$P(^KUL(KLNr,"F",BONNr,OLNr),D,17)="KF5" ORDNr=+$P(^KUL(KLNr,"F",BONNr,OLNr),D,5)
 Quit ORDNr
 
CHKTELB(RecI) ; Nagaan of de groep telbaar is
 New GR,KKey
 Set GR=$P(RecI,D,2)
 Set KKey=$$GETKEY^KLASS(GR)
 Quit:'KKey 1
 Quit $P(^KLAS("K",KKey),D,12) ; Subgroep nivo
 
FETCHFA(Node,Glob,HGSelect,VanWeek)   ; Fakturen en proforma
 Set FNode="A"
 For  Set FNode=$O(@Glob@(FNode)) Quit:FNode=""  Do
 . Set FAKNr=$S(Node="F":99999,1:0)
 . For  Set FAKNr=$O(@Glob@(FNode,FAKNr)) Quit:FAKNr=""  Do  ;Quit:FAKNr>399999 
 ..  Set BONNr="U"
 ..  Set KLNr=$P(@Glob@(FNode,FAKNr,0,0),D)
 ..  Set NewOrd=1
 ..  For  Set BONNr=$O(@Glob@(FNode,FAKNr,BONNr)) Quit:BONNr=""  Do
 ...   Set OLNr=99
 ...   Set LevWk=$$INTDATE^vhDTyp($P(@Glob@(FNode,FAKNr,BONNr,1),D,2))
 ...   Set LevWk=$$CALCDATE^vhDTyp(LevWk,"W","MD")
 ...   For  Set OLNr=$O(@Glob@(FNode,FAKNr,BONNr,OLNr)) Quit:OLNr=""  Do
 ....    Set Rec=@Glob@(FNode,FAKNr,BONNr,OLNr)
 ....    If $P(Rec,D,17)="KF5" Set NewOrd=1 ; Orderhoofding
 ....    Set PRNr=$P(Rec,D,2)
 ....    Quit:'PRNr
 ....    Set Key=$O(^KPR(PRNr,"I"))
 ....    If $E(Key)="I" Set RecI=^KPR(PRNr,Key)
 ....    Else  Do  ; Deleted products
 .....     Set Key=$O(^KPRO(PRNr,"I"))
 .....     Set:$E(Key)="I" RecI=^KPRO(PRNr,Key)
 ....    Quit:$P(RecI,D)'[HGSelect
 ....    Quit:'$$CHKTELB(RecI)
 ....    Set Qty=$P(Rec,D,3)
 ....    Set Omzet=$P(Rec,D,34)
 ....    Set Marge=Omzet-$P(Rec,D,33)
 ....    ;Set LevWk=$S($P(Rec,D,25)?5N:$P(Rec,D,25),1:$$INTDATE^vhDTyp($P(Rec,D,25),"DW"))
 ....    If $G(VanWeek) Quit:VanWeek>LevWk
 ....    Do STORE(Node,PRNr,KLNr,FAKNr,$E(BONNr,2,99),,NewOrd,LevWk,Qty,Omzet,Marge)
 ....    Set NewOrd=0
 Quit
 
EXPORT Set Dev=0
 Set Dev=$$OPEN^vhDEV(,"ORGAPRODS.TXT","W")
 Use Dev
 Set (Datum,Type,KLNr,VolgNr)=""
 For  Set Datum=$O(^ORGASTAT("P",Datum)) Quit:Datum=""  Do
 .For  Set Type=$O(^ORGASTAT("P",Datum,Type)) Quit:Type=""  Do
 ..For  Set KLNr=$O(^ORGASTAT("P",Datum,Type,KLNr)) Quit:KLNr=""  Do
 ...For  Set VolgNr=$O(^ORGASTAT("P",Datum,Type,KLNr,VolgNr)) Quit:VolgNr=""  Do
 ....Set Rec=^ORGASTAT("P",Datum,Type,KLNr,VolgNr)
 ....Set PRNr=$P(Rec,D,1)
 ....Set Qty=$P(Rec,D,6)
 ....Set FAKNr=$P(Rec,D,2)
 ....Set KortT=$P($G(^KPR(PRNr,0)),D,1)
 ....Quit:KortT=""
 ....Set SortKey=$$SORTKEY^PRODUKT(PRNr)
 ....Set KLNm=$P(^KKL(^KK1(KLNr),0),D,2)
 ....Write Type,$C(9),$$EXTDATE^vhDTyp(Datum),$C(9),KLNr,$C(9),KLNm,$C(9),FAKNr,$C(9),SortKey,$C(9),PRNr,$C(9),KortT,$C(9),Qty,!
 Close:0'[Dev Dev