levperf ; Leveringsperformantie [ 02/17/2003  3:39 PM ]
 ;
 ; Nachtelijke scanning van de verstreken orders
NIGHT 
 Set $ZT="^cA406"
 New
 Set Q="K"
 Do ^cA604
SCAN Lock +LEVPERF:0 Else  Quit  ; Indien gelockt dan onmiddellijk quit
 Set KLNr=0
 For  Set KLNr=$O(^KOD(KLNr)) Quit:KLNr=""  Do
 .Set ORDNr=""
 .Set Krediet=$$KREDTVAL(KLNr)
 .For  Set ORDNr=$O(^KOD(KLNr,"F",ORDNr)) Quit:ORDNr=""  Do
 ..Set R=^KOD(KLNr,"F",ORDNr,1),OrdTyp=$P(R,D,25)
 ..Quit:"\C\A\"[(D_OrdTyp_D)
 ..Set OLNr=100
 ..For  Set OLNr=$O(^KOD(KLNr,"F",ORDNr,OLNr)) Quit:OLNr=""  Do
 ...Set R=^KOD(KLNr,"F",ORDNr,OLNr),PRNr=$P(R,D,2),Aantal=$P(R,D,3),Update=$P(R,D,39)
 ...Quit:Update+7'<$H
 ...If PRNr,Aantal>0,'$$CHKLEVT(KLNr,ORDNr,OLNr) Do STORE(KLNr,,ORDNr,OLNr,,Krediet)
 ; Opkuis van de op bon gezette orders
 Set ORDNr=""
 For  Set ORDNr=$O(^LEVPERF("DEL","B",ORDNr)) Quit:ORDNr=""  Do
 .Set OLUNr=""
 .For  Set OLUNr=$O(^LEVPERF("DEL","B",ORDNr,OLUNr)) Quit:OLUNr=""  Do
 ..Set (StatDat,LastDat,LogCount,StrafPnt)=""
 ..For  Set StatDat=$O(^LEVPERF("D",StatDat),-1) Quit:StatDat=""  Do
 ...Set R=$G(^LEVPERF("D",StatDat,ORDNr,OLUNr))
 ...Quit:R=""
 ...Set LogCount=LogCount+1 Set:$P(R,D,14)>StrafPnt StrafPnt=$P(R,D,14)
 ...If 'LastDat Set LastDat=StatDat
 ...Else  Kill ^LEVPERF("D",StatDat,ORDNr,OLUNr)
 ..Quit:LastDat=""
 ..Set R=^LEVPERF("D",LastDat,ORDNr,OLUNr),$P(R,D,14)=StrafPnt
 ..Set $P(R,D,22)=LogCount,^LEVPERF("D",LastDat,ORDNr,OLUNr)=R
 ; Opkuis van de verwijderde orders
 Set StatDat=""
 For  Set StatDat=$O(^LEVPERF("D",StatDat)) Quit:StatDat=""  Do
 .Set ORDNr=""
 .For  Set ORDNr=$O(^LEVPERF("D",StatDat,ORDNr)) Quit:ORDNr=""  Do
 ..Set OLUNr=""
 ..For  Set OLUNr=$O(^LEVPERF("D",StatDat,ORDNr,OLUNr)) Quit:OLUNr=""  Do
 ...Kill:$D(^LEVPERF("DEL","D",ORDNr,OLUNr)) ^LEVPERF("D",StatDat,ORDNr,OLUNr)
 Kill ^LEVPERF("DEL")
 Lock -LEVPERF
 Quit
 
 ;Krediet evaluatie
 ; + : Heeft kredietlimiet en alles is OK
 ; - : Heeft kredietlimiet en deze is overschreden of er zijn achterstallige fakturen
 ; K : Heeft GEEN kredietlimiet maar er zijn achterstallige fakturen
 ; "" : Niets aan de hand
KREDTVAL(KLNr) 
 New R,Waardig,KrdtLim
 Set R=$$WAARDIG^KREDIET(KLNr),Waardig=$P(R,D)
 Set KrdtLim=$$GETLIM^KREDIET(KLNr)
 If KrdtLim Do  ; Er is een kredietlimiet
 . Set Waardig=$S(Waardig:"+",1:"-")
 Else  Do  ; Zonder kreditelimiet
 . Set Waardig=$S(Waardig:"",1:"K")
 Quit Waardig
 
 ; Kontrole of de beloofde datum of de leverweek verstreken zijn
CHKLEVT(KLNr,ORDNr,OLNr) 
 New R,Beloofd,ChkLevT,ChkLevWk,LevWk
 Set R=^KOD(KLNr,"F",ORDNr,1),Beloofd=$$INTDATE^vhDTyp($P(R,D,16))
 If Beloofd Set ChkLevT=Beloofd'<$H
 Else  Do
 .Set ChkLevWk=$$CALCDATE^vhDTyp(,"W")
 .Set R=^KOD(KLNr,"F",ORDNr,OLNr),LevWk=$$INTDATE^vhDTyp($P(R,D,25),"DW")
 .Set ChkLevT=LevWk'<ChkLevWk
 Quit ChkLevT
 ;
 ; Berekenen verschil leverweek t.o.v. huidige week, in kalenderdagen
LEVTVAL(KLNr,ORDNr,OLNr) 
 New R,Beloofd,LevEval,LevWk
 Set R=^KOD(KLNr,"F",ORDNr,1),Beloofd=$$INTDATE^vhDTyp($P(R,D,16))
 If Beloofd Set LevEval=Beloofd-$H
 Else  Do
 .Set ChkLevWk=$$CALCDATE^vhDTyp(,"W","MD") ; Midden van de week
 .Set R=^KOD(KLNr,"F",ORDNr,OLNr),LevWk=$$INTDATE^vhDTyp($P(R,D,25),"DW")
 .Set LevWk=$$CALCDATE^vhDTyp(LevWk,"W","MD") ; Midden van de week
 .Set LevEval=LevWk-ChkLevWk
 Quit LevEval
 
STORE(KLNr,BONNr,ORDNr,OLNr,Geleverd,Krediet) 
 New J,R,OrdTime,Beloofd,LevEval,OrdTyp,PRNr,Aantal,OLUNr,LevWk,VLevTime,ELevTime,User
 New FysStock,PraStock,TeoStock,GemWvk,StrafPnt,StockNSt,ABCKlas,PRLevT,IsKOM,LEVNr,TOENr,TLNr,TLUNr
 Lock +^KOD(KLNr,"F",ORDNr):1 Else  Quit
 Set BONNr=$G(BONNr),Geleverd=$G(Geleverd)
 Set VLevTime=""
 Do:BONNr
 .Set R=$G(^ORDW("D",BONNr)),VLevTime=$P(R,D,5)
 .Quit:VLevTime
 .Set R=^KUL(KLNr,"F",BONNr,1),VLevTime=$$INTDATE^vhDTyp($P(R,D,2))
 Set R=^KOD(KLNr,"F",ORDNr,1),Beloofd=$$INTDATE^vhDTyp($P(R,D,16)),OrdTyp=$P(R,D,25)
 Set User=$P($P(R,D,8),"#"),OrdTime=$P($P(R,D,8),"#",3) Set:'OrdTime OrdTime=$$INTDATE^vhDTyp($P(R,D,2))
 Set R=^KOD(KLNr,"F",ORDNr,OLNr),$P(R,D,39)=+$H,^KOD(KLNr,"F",ORDNr,OLNr)=R
 Set PRNr=$P(R,D,2),Aantal=$P(R,D,3),OLUNr=$P(R,D,15)
 Set LevWk=$$INTDATE^vhDTyp($P(R,D,25),"DW"),TOENr=$P(R,D,27),TLNr=$P(R,D,28)
 If 'TLNr Set IsKOM=$S($L(TLNr):"K",1:"")
 Else  Do
 .Set IsKOM="T"
 .Set R=^KTO1(TOENr),LEVNr=$P(R,D),R=^KTO(LEVNr,TOENr,TLNr),TLUNr=$P(R,D,15)
 .If TLUNr,$D(^RCP("IT",TOENr,TLUNr)) Set IsKOM="W"
 Set R=^KPR(PRNr,0),ABCKlas=$P($P(R,D,8),"#",2),FysStock=$P(R,D,14)
 Set R=^KPR(PRNr,1),StockNSt=$P(R,D,20),GemWvk=$P($P(R,D,23),"#")+$P($P(R,D,23),"#",2)
 Set StockNSt=$S($D(^KPBI("D",KLNr,PRNr)):"C",1:$P("N\S",D,StockNSt+1))
 Set R=$$GETSTOCK^PRODUKT4(PRNr),PraStock=$P(R,D,2),TeoStock=$P(R,D,3)
 Set J=$O(^KPR(PRNr,"J")),R="" Set:$E(J)="J" R=^KPR(PRNr,J) Set PRLevT=$P(R,D,7)
 Set ELevTime="",LevEval=$$LEVTVAL(KLNr,ORDNr,OLNr)
 
 If FysStock<Aantal Set StrafPnt=3 ; Toekenning strafpunten
 Else  If PraStock<0 Set StrafPnt=2
 Else  If '$L(IsKOM),FysStock<(GemWvk*PRLevT) Set StrafPnt=1
 Else  Set StrafPnt=0
 If IsKOM="T",StrafPnt Set StrafPnt=5
 Set R=KLNr_D_OrdTyp_D_OrdTime_D_VLevTime_D_ELevTime_D_BONNr_D_PRNr_D_Geleverd_D_Aantal_D_FysStock_D_PraStock_D_TeoStock
 Set R=R_D_GemWvk_D_StrafPnt_D_LevEval_D_Beloofd_D_LevWk_D_Krediet_D_StockNSt_D_ABCKlas_D_IsKOM_D_D_User
 Set ^LEVPERF("D",+$H,ORDNr,OLUNr)=R
 If BONNr,Aantal=Geleverd!Geleverd Do STOREDEL(ORDNr,OLUNr,"B")
 Lock -^KOD(KLNr,"F",ORDNr)
 Quit
 ;
STOREDEL(ORDNr,OLUNr,Type) 
 If ORDNr,OLUNr,$L(Type) Set ^LEVPERF("DEL",Type,ORDNr,OLUNr)=""
 Quit
 ;