HADSTAT2 ;Statistiek portefeuille [ 03/27/2003  9:22 PM ]
 Quit
 
NIGHT S $ZT="^cA406",Q="K" D ^cA604
 Set LEVNr=6332 ; HALUX
 Do FETCH("TOBFP",,0) 
 Quit
 
JOB Job NIGHT^HADSTAT2
 Do WARN^vhTXTPOP("Achtergrond opdracht gestart~Duurtijd ongeveer 15 min.")
 Quit
 
ISJOB() Lock +^HADSTAT:0 Else  Do  Quit 1
 .Do WARN^vhTXTPOP("Ophalen van de gegevens is NOG STEEDS bezig","Achtergrond opdracht")
 Lock -^HADSTAT
 ;Do WARN^vhTXTPOP("Niet bezig","Achtergrond opdracht")
 Quit 0
 
REFRESH(LEVNr,ItemList) 
 Do FETCH(ItemList,,1)
 Quit
 
FETCH(ItemList,VanWeek,Display) 
 ; Optioneel : Vanweek : oude gegevens blijven bestaan
 ; Optioneel : Display : met tussentijdse gegeven display
 Lock +^HADSTAT:1 Else  Do:$G(Display)  Quit
 .Set FP=2301 Write @F,@F1,!,"Databank gelockt, geen nieuwe gegevens opgehaald" Hang 5
 Set FP=2301 Write:$G(Display) @F,@F1,!,"Verwerken toeleveringen"
 If '$G(Display) Do MarkDeletedToelev ; Markeren in HADPR("F" of de toelevering verwijderd zijn
 If ItemList["T" Do FETCHTOE(LEVNr)
 Set FP=2301 Write:$G(Display) @F,@F1,!,"Verwerken orders"
 If ItemList["O" Do CLEAN("K"),CLEAN("O"),FETCHORD
 Write:$G(Display) @F,@F1,!,"Verwerken bons"
 If ItemList["B" Do CLEAN("B"),FETCHUL
 Write:$G(Display) @F,@F1,!,"Verwerken fakturen"
 If ItemList["F" Do CLEAN("F",$G(VanWeek)),FETCHFA("F",$NA(^KFA),$G(VanWeek))
 Write:$G(Display) @F,@F1,!,"Verwerken proforma"
 If ItemList["P" Do CLEAN("P",$G(VanWeek)),FETCHFA("P",$NA(^KFAP),$G(VanWeek))
 Write:$G(Display) @F,@F1
 Lock -^HADSTAT
 Quit
 
CLEAN(Node,VanWeek) 
 Set Wk=""
 For  Set Wk=$O(^HADSTAT("O",LEVNr,Wk)) Quit:Wk=""  Do
 .If $G(VanWeek) Quit:VanWeek>Wk  ; Oude laten staan
 .Kill ^HADSTAT("O",LEVNr,Wk,Node)
 .Kill ^HADSTAT("D",LEVNr,Wk,Node)
 Quit 
 
FETCHORD 
 New Batches,PRNr,ORDNr,OLUNr,KLNr,Rec,Qty,Tot,TOENr,TLNr,Tot,Munt,LevWk,ProdWk
 Set PRNr=""
 For  Set PRNr=$O(^ORD("IP",PRNr)) Quit:PRNr=""  Do
 .Quit:'$D(^KPR(PRNr,"J"_LEVNr))
 .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 Proforma=$P(^KOD(KLNr,"F",ORDNr,1),D,25)="P"
 ...Set Rec=$G(^KOD(KLNr,"F",ORDNr,OLNr))
 ...Quit:Rec=""
 ...Set Qty=$P(Rec,D,3)
 ...Set Tot=$P(Rec,D,16)
 ...Set TOENr=$P(Rec,D,27)
 ...Set TLNr=$P(Rec,D,28)
 ...Set:'Tot NulOrd(ORDNr)=KLNr
 ...Set Munt=$$MUNTPAR^vhRtn1($P(Rec,D,22))
 ...Set LevWk=$$CALCDATE^vhLib.DataTypes($P(Rec,D,25),"W","MD")
 ...Set:$P(^KOD(KLNr,"F",ORDNr,1),D,25)="C" LevWk=$$CALCDATE^vhLib.DataTypes($P(Rec,D,29),"W","MD") ; Contract
 ...Set (ProdWk,TLUNr)=""
 ...Set:TOENr ProdWk=$$INTDATE^vhLib.DataTypes($P($G(^KTO(LEVNr,TOENr,TLNr)),D,25),"DW")
 ...Set TLUNr=$S(TOENr:$P($G(^KTO(LEVNr,TOENr,TLNr)),D,15),1:"")
 ...Set:ProdWk="" ProdWk=$$CALCDATE^vhLib.DataTypes(LevWk,"A",-5) ; Productie week vijf arbeidsdagen voor de leverweek
 ...Set Node=$S(TOENr?6N:"K",1:"O") ; KOM of NIET-KOM
 ...Do STORE(Node,PRNr,KLNr,,,ORDNr,OLUNr,TOENr,TLUNr,LevWk,Qty,Tot/Munt,,ProdWk)
 Quit
 
FETCHTOE(LEVNr) 
 New Batches,PRNr,ORDNr,OLUNr,KLNr,Rec,Qty,Tot,TOENr,TLNr,Tot,Munt,LevWk,ProdWk
 Kill ^HADPR("O") ; Verwijder batchlijst
 Merge Batches=^HADPR("B")
 Kill ^HADPR("B") ; Verwijder batch info
 Set LEVNr=$G(LEVNr,6332)
 Set (TOENr,TLNr)=""
 For  Set TOENr=$O(^KTO(LEVNr,TOENr)) Quit:TOENr=""  Do
 .Set KLNr=$P(^KTO(LEVNr,TOENr,1),D,8)
 .Set TLNr=99
 .For  Set TLNr=$O(^KTO(LEVNr,TOENr,TLNr)) Quit:TLNr=""  Do
 ..Set Rec=^KTO(LEVNr,TOENr,TLNr)
 ..Set PRNr=$P(Rec,D,2)
 ..Quit:'PRNr
 ..Set TLUNr=$P(Rec,D,15)
 ..Set Qty=$P(Rec,D,3)
 ..Set ORDNr=$P(Rec,D,27)
 ..Set OLNr=$P(Rec,D,28)
 ..Set (Proforma,Munt)=0
 ..Set (OLUNr,LevWk)=""
 ..If KLNr,ORDNr,OLNr,$D(^KOD(KLNr,"F",ORDNr,OLNr)) Do
 ...Set OLUNr=$P(^KOD(KLNr,"F",ORDNr,OLNr),D,15)
 ...Set Proforma=$P(^KOD(KLNr,"F",ORDNr,1),D,25)="P"
 ..Else  Set KLNr=""
 ..Set ProdWk=$$INTDATE^vhLib.DataTypes($P($G(^KTO(LEVNr,TOENr,TLNr)),D,25),"DW")
 ..Do STORE("T",PRNr,KLNr,,,ORDNr,OLUNr,TOENr,TLUNr,LevWk,Qty,0,,ProdWk)
 Quit
 
STORE(Node,PRNr,KLNr,FAKNr,ULNr,ORDNr,LijnNr,TOENr,TLUNr,LevWk,Qty,Omzet,Marge,ProdWk) 
 New GNode,Node0,Montage,Batch,GenRec,GenPRNr
 Set FAKNr=$G(FAKNr)
 Set ULNr=$G(ULNr)
 Set ORDNr=$G(ORDNr)
 Set Marge=$G(Marge)
 If Marge="" Do
 .Set Marge=Omzet-($P(^KPR(PRNr,"J"_LEVNr),D,23)*Qty) ; Marge=Omzet-Aankoop
 Set GNode=$G(^KPR(PRNr,"G"))
 Set:GNode="" GNode=$G(^KPRO(PRNr,"G"))
 Set Node0=$G(^KPR(PRNr,0))
 Set:Node0="" Node0=$G(^KPRO(PRNr,0))
 
 Set Montage="DV"
 Set GenRec=$$GENTYP^HAD(PRNr)
 If $L($P(GenRec,D)) Do
 .Set:$P(GenRec,D)="KAD" Montage="KZ"  ; Kaderdeur ongemonteerd
 .Set:$P(GenRec,D)="RVG" Montage="RV"  ; Revego
 .Set:Montage="KZ"&($P(GNode,D,11)!($P(GNode,D,11)["K")) Montage="KM" ; Kaderdeur gemonteerd
 .Set:$P(GenRec,D)="BAN" Montage="BA" ; Banco
 .Set:$P(GenRec,D)="GLA" Montage="DV" ; Glas
 .Set:$P(GenRec,D)="PRF" Montage="PR" ; Losse profielen
 .Set:$P(GenRec,D)="TBX" Montage="T"_$S($P(GenRec,D,2)="PR+":"K",$P(GenRec,D,2)="PRO":"P",1:"X") ; Tandembox (std en pro)
 .Set:$P(GenRec,D)="LBX" Montage="L"_$S($P(GenRec,D,2)="STD":"X",1:"P") ; Legrabox(std en pro)
 .Set:$P(GenRec,D)="MVX" Montage="M"_$S($P(GenRec,D,2)="STD":"X",1:"P") ; Merivobox(std en pro)
 .Set:$P(GenRec,D)="TAO" Montage="TA" ; TA'OR (std en pro)
 .Set:$P(GenRec,D,1,2)="TBX\BBX" Montage="BB" ; Burobox
 .Set:$P(GenRec,D,1,2)="DIV\POM" Montage="PM" ; Producten op maat
 .Set:$P(GenRec,D,1,2)="DIV\GRP" Montage="GM" ; Grepen op maat
 .Set:$P(GenRec,D,1,2)="DIV\TLM" Montage="VM" ; Verlichting op maat
 .Set:$P(GenRec,D,1,2)="DIV\ASM" Montage="MM" ; Matjes op maat
 .Set:$P(GenRec,D,1,2)="DIV\INP" Montage="II" ; Inpak
 
 If Node="T" Do  ; Toelevering
 .Do DTLPR(Montage)
 Else  Do
 .Do CUMUL(Montage)
 .Do DTL(Montage)
 Quit
 
CUMUL(Soort) 
 New Rec
 Set Rec=$G(^HADSTAT("O",LEVNr,LevWk,Node,Soort))
 Set:Qty>0 $P(Rec,D,1)=$P(Rec,D,1)+Qty
 Set $P(Rec,D,2)=$P(Rec,D,2)+1
 Set $P(Rec,D,3)=$P(Rec,D,3)+Omzet
 Set $P(Rec,D,4)=$P(Rec,D,4)+Marge
 Set ^HADSTAT("O",LEVNr,LevWk,Node,Soort)=Rec
 Quit
 
DTL(Soort) 
 New Rec,VolgNr,Batch,FabKey
 Set FabKey=$$FABKEYT^HADOPV($G(TOENr),$G(TLUNr))
 Set:$L(FabKey) Batch=$P($G(^HADPR("F",FabKey)),D,1)
 Set Rec=Soort_D_KLNr_D_PRNr_D_FAKNr_D_ULNr_D_ORDNr_D_LijnNr_D_$G(TOENr)_D_Qty_D_Omzet_D_Marge_D_$G(Batch)
 
 Set VolgNr=$O(^HADSTAT("D",LEVNr,LevWk,Node,""),-1)+1
 Set ^HADSTAT("D",LEVNr,LevWk,Node,VolgNr)=Rec
 Quit
 
DTLPR(Soort) 
 New VolgNr,Rec,FabKey,IsMES
 Set FabKey=$$FABKEYT^HADOPV(TOENr,TLUNr)
 Set IsMES=##class(OBJTimpl.CheckObjectiveFase).IsProductieSysteemMES(PRNr)
 If $P($G(^HADPR("F",FabKey),"\\\1"),"\",4) Do 
 . Kill ^HADPR("F",FabKey) ; Opkuis van oude data bij hergebruik van toeleveringsnummer (round robin)
 . Do MARKDEF^HADOPV(PRNr,TOENr,TLUNr) ; Indien eerste maal default markeringen
 Set Batch=$P($G(^HADPR("F",FabKey)),D,1)
 If Batch="" Do  ; Kreatie van default batch voor productie
 .Set Rec=$G(^HADPR("F",FabKey))
 .Set Batch=$E(100+$$EXTDATE^vhLib.DataTypes(ProdWk,"W"),2,3)_" "
 .Set:(Soort="KZ")!(Soort="PR") $E(Batch,3)="P" ;Losse profielen of zonder vulling -> aparte batch "..P"
 .Set:$G(Proforma) $E(Batch,3)="Z" ; Proforma's aparte batch
 .Set:(Soort="BA") $E(Batch,3)="B" ; Banco aparte batch "..B"
 .Set:(Soort="DV") $E(Batch,3)="D" ; Diverse aparte batch "..D"
 .Set:($E(Soort)="T") Batch=$E(Soort,1,2)_" " ; Tandembox en TA'OR BOX
 .Set:($E(Soort)="L") Batch=$E(Soort,1,2)_" " ; Legrabox
 .Set:($E(Soort)="M") Batch=$E(Soort,1,2)_" " ; Merivobox
 .Set:(Soort="VM")||(Soort="PM")||(Soort="GM")||(Soort="BB")||(Soort="MM") Batch=Soort_" "
 .Set:Soort="RV" Batch="RVG"
 .Set:IsMES Batch="MES" ; alle lades die in OBJT MES verwerkt worden
 .Set $P(Rec,D,1)=Batch
 .Set:LevWk=ProdWk $P(Rec,D,2)="A"
 .Set $P(Rec,D,3)=PRNr
 .Set ^HADPR("F",FabKey)=Rec
 If $D(Batches(Batch)) Do  ; Controle of batch reeds bestand - copy van HADPR("B")
 .Merge ^HADPR("B",Batch)=Batches(Batch)
 Else  Do  ; Creatie batch met default informatie
 .Set Rec="Week "_$$EXTDATE^vhLib.DataTypes(ProdWk,"W")_" "_$S($E(Batch,3)="B":"Banco",$E(Batch,3)="P":"Profiel",$E(Batch,3)="D":"Diverse",$E(Batch,3)="Z":"Proforma/Herstelling",1:"basis")
 .Set:$E(Soort)="T" Rec="TBX "_$S($E(Soort,2)="X":"V1",1:"Probox,...")
 .Set:$E(Soort)="L" Rec="LBX "_$S($E(Soort,2)="X":"V1",1:"Probox,...")
 .Set:$E(Soort)="M" Rec="MVX "_$S($E(Soort,2)="X":"V1",1:"Probox,...")
 .Set:$E(Soort,1,2)="MM" Rec="Mat op maat"
 .Set:$E(Soort,1,2)="TA" Rec="TAX"
 .Set:Soort="RV" Rec="Revego"
 .Set:IsMES Rec="Verwerkt door MES" ; alle lades die in OBJT MES verwerkt worden
 .Set $P(Rec,D,2)=$H
 .Set $P(Rec,D,3)=$$CALCDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes(ProdWk,"W","FD"),"A","-0")
 .Set $P(Rec,D,4)=$$CALCDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes(ProdWk,"W","LD"),"A","+0")
 .Set ^HADPR("B",Batch)=Rec
 Set Rec=Soort_D_KLNr_D_PRNr_D_ORDNr_D_TLUNr_D_TOENr_D_Qty_D_Batch
 Set:'$D(^HADPR("B",Batch)) ^HADPR("B",Batch)="Week "_$$EXTDATE^vhLib.DataTypes(ProdWk,"DW")_D_$H
 Set VolgNr=$O(^HADPR("O",Batch,""),-1)+1
 Set ^HADPR("O",Batch,VolgNr)=Rec
 Quit
 
FETCHUL ; Leveringsbons
 Set KLNr=""
 For  Set KLNr=$O(^KUL(KLNr)) Quit:KLNr=""  Do
 .Set BONNr="",OLNr=""
 .For  Set BONNr=$O(^KUL(KLNr,"F",BONNr)) Quit:BONNr=""  Do
 ..For  Set OLNr=$O(^KUL(KLNr,"F",BONNr,OLNr)) Quit:'OLNr  Do
 ...Set Rec=^KUL(KLNr,"F",BONNr,OLNr)
 ...Set PRNr=$P(Rec,D,2)
 ...Quit:'PRNr
 ...Quit:'$D(^KPR(PRNr,"J"_LEVNr))
 ...Set Qty=$P(Rec,D,3)
 ...Set Tot=$P(Rec,D,16)
 ...Set Munt=$$MUNTPAR^vhRtn1($P(Rec,D,22))
 ...Set LevWk=$$CALCDATE^vhLib.DataTypes($P(Rec,D,25),"W","MD")
 ...Do STORE("B",PRNr,KLNr,,BONNr,,OLNr,,,LevWk,Qty,Tot/Munt)
 Quit
 
FETCHFA(Node,Glob,VanWeek) ; Fakturen en proforma
 Set FNode="A"
 For  Set FNode=$O(@Glob@(FNode)) Quit:FNode=""  Do
 .Set FAKNr=""
 .For  Set FAKNr=$O(@Glob@(FNode,FAKNr)) Quit:FAKNr=""  Do  ;Quit:FAKNr>199999  Do
 ..Set BONNr="U"
 ..Set KLNr=$P(@Glob@(FNode,FAKNr,0,0),D)
 ..For  Set BONNr=$O(@Glob@(FNode,FAKNr,BONNr)) Quit:BONNr=""  Do
 ...Set OLNr=99
 ...For  Set OLNr=$O(@Glob@(FNode,FAKNr,BONNr,OLNr)) Quit:OLNr=""  Do
 ....Set Rec=@Glob@(FNode,FAKNr,BONNr,OLNr)
 ....Set PRNr=$P(Rec,D,2)
 ....Quit:'PRNr
 ....Quit:'$D(^KPR(PRNr,"J"_LEVNr))
 ....Set Qty=$P(Rec,D,3)
 ....Set Omzet=$P(Rec,D,34)
 ....Set Marge=Omzet-$P(Rec,D,33)
 ....Set LevWk=$$CALCDATE^vhLib.DataTypes($P(Rec,D,25),"W","MD")
 ....If $G(VanWeek) Quit:VanWeek>LevWk
 ....Do STORE(Node,PRNr,KLNr,FAKNr,$E(BONNr,2,99),,OLNr,,,LevWk,Qty,Omzet,Marge)
 Quit
 
 ; Controleren of een toelevering nog bestaat
 ; Indien deze niet meer bestaat dan wordt ^HADPR("F",FabKey) gemarkeerd als zijnde deleted
MarkDeletedToelev
 Set FabKey=""
 For  Set FabKey=$O(^HADPR("F",FabKey)) Quit:FabKey=""  Do
 . If FabKey'="",('$P(FabKey,";"))||('$P(FabKey,";",2)) Kill ^HADPR("F",FabKey) Quit ; Soms staan er bizarre dingen zoals FabKey="^HULP($J)" deze verwijderen,eingelijk moet er gezocht worden zo er komen
 . Quit:$D(^TO("IU",$P(FabKey,";"))) ; Toelevering bestaat nog
 . Set MarkDat=$P($G(^HADPR("F",FabKey),"\\\1"),"\",4) ; Markeer datum
 . Set:MarkDat=1 MarkDat=+$H,$P(^HADPR("F",FabKey),"\",4)=MarkDat
 . If MarkDat<($H-150) Kill ^HADPR("F",FabKey) ; Verwijderen van ^HADPR("F",FabKey) na 150 dagen
 . Quit:MarkDat ; Reeds gemarkeerd
 . Set $P(^HADPR("F",FabKey),"\",4)=+$H ; Markeer als deleted
 Quit