LEVPERF ; Leveringsperformantie [ 03/24/2003 10:09 AM ] ; ; Nachtelijke scanning van de verstreken orders NIGHT ; Deze job moet draaien in de vroege morgen en niet in de vroege avond. ; Dit omdat zondag de laatste dag van week is, en de routine moet voor de maandag morgen lopen. Set $ZT="^cA406" New Set Q="K" Do ^cA604 SCAN Lock +LEVPERF:0 Else Quit ; Indien gelockt dan onmiddellijk quit ; Opslaan kenmerken Set KLNr=0 For Set KLNr=$O(^KOD(KLNr)) Quit:KLNr="" Do .Set ORDNr="" .Set Krediet=$$KREDIET(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 ...If $$CHKSCAN(KLNr,ORDNr,OLNr) Do ; Eerst controleren of het moet opgenomen worden .... Do SCANMERG(KLNr,ORDNr,OLNr,Krediet) ; Verwerken van orderlijnen die op bon zijn gezet Set ORDNr="" For Set ORDNr=$O(^LEVPERF("B",ORDNr)) Quit:ORDNr="" Do . Set OLUNr="" . For Set OLUNr=$O(^LEVPERF("B",ORDNr,OLUNr)) Quit:OLUNr="" Do .. Set BonRec=^LEVPERF("B",ORDNr,OLUNr) .. Do BLDSTAT($P(BonRec,D,1),ORDNr,OLUNr,$P(BonRec,D,2),$P(BonRec,D,3),$P(BonRec,D,4),$P(BonRec,D,5),$P(BonRec,D,6)) ; Opkuis van de onbestaande orderlijnen Set ORDNr="" For Set ORDNr=$O(^LEVPERF("O",ORDNr)) Quit:ORDNr="" Do . Set OLUNr="" . For Set OLUNr=$O(^LEVPERF("O",ORDNr,OLUNr)) Quit:OLUNr="" Do .. Kill:'$D(^ORD("IU",ORDNr,OLUNr)) ^LEVPERF("O",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 KREDIET(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 kredietlimiet . Set Waardig=$S(Waardig:"",1:"K") Quit Waardig ;Controle scanperiode : ;Controle of de leverweek binnen de productlevertermijn valt ; of het geen terugname is ; of het met stockaanpassing is ; of reeds opgenomen in EWMS CHKSCAN(KLNr,ORDNr,OLNr) New R,PRNr,J,LevWk,PRLevT,J Set R=^KOD(KLNr,"F",ORDNr,OLNr),LevWk=$$INTDATE^vhLib.DataTypes($P(R,D,25),"DW","FD") Set PRNr=$P(R,D,2) Quit:PRNr'?4.7N 0 Quit:$P(R,D,3)<0 0 ; Terugname Quit:$P(R,D,14)["S" 0 ; zonder stockaanpassing oud Quit:$P(R,D,14)["Z" 0 ; zonder stockaanpassing Quit:$D(^ORDW("IO",ORDNr,$P(R,D,15))) 0 ;opgenomen in EWMS Set J=$O(^KPR(PRNr,"J")),R="" Set:$E(J)="J" R=^KPR(PRNr,J) Set PRLevT=$P(R,D,7) ; Productlevertermijn Quit LevWk<($H+((PRLevT+2)*7)) ; Leverweek valt binnen de levertermijn incl 2 weken buffer ; Berekenen verschil leverweek t.o.v. huidige week, in kalenderdagen LVWKDIFF(KLNr,ORDNr,OLNr) New R,Beloofd,LevEval,LevWk Set R=^KOD(KLNr,"F",ORDNr,1),Beloofd=$$INTDATE^vhLib.DataTypes($P(R,D,16)) If Beloofd Set LevEval=Beloofd-$H Else Do .Set ChkLevWk=+$H .Set R=^KOD(KLNr,"F",ORDNr,OLNr),LevWk=$P(R,D,25) .Set LevEval=LevWk-ChkLevWk Quit LevEval SCANMERG(KLNr,ORDNr,OLNr,Krediet) New R,OLUNr,ScanRec Lock +^KOD(KLNr,"F",ORDNr):0 Else Quit Set R=^KOD(KLNr,"F",ORDNr,OLNr) Set OLUNr=$P(R,D,15) Set ScanRec=$$GETSCAN(KLNr,ORDNr,OLNr,Krediet) ; Opkuis van de op bon gezette orders Set ScanRec=$$MERGSCAN(ORDNr,OLUNr,ScanRec) ; Merge met vorige Do PUTSCAN(ORDNr,OLUNr,ScanRec) ; Opslaan in LEVPERF Lock -^KOD(KLNr,"F",ORDNr):0 Quit ; Stockcontrole op de dynamische theoretische stock STOCKCTR(ORDNr,OLUNr,PRNr,Aantal,IsKOM,OLevWk) New ToeStock,TeoM1Stock,Stock,StrafPnt Set:'$G(OLevWk) OLevWk=$$EXTDATE^vhLib.DataTypes($H,"DW") Set R=$$DYNSTOCK^PRODUKT4(PRNr,,OLevWk) Set TeoStock=$P(R,D,3),TeoM1Stock=$P(R,D,4) Set StrafPnt=0,Stock=TeoStock ; Alles OK If TeoStock<0 Set StrafPnt=2,Stock=TeoStock ; te weinig theoretische dyn.stock Else If TeoM1Stock<0 Set StrafPnt=1,Stock=TeoM1Stock ; te theoretische stock dyn.stock zonder de toelevering van de laatste week Quit StrafPnt_D_Stock GETSCAN(KLNr,ORDNr,OLNr,Krediet) New J,R,PRNr,Aantal,OLUNr,OLevWk,FysStock,PraStock,TeoStock,StrafPnt,StockNSt,IsKOM,LEVNr,TOENr,TLNr,TLUNr,TLLevWk,Beloofd,OLRec,ORDRec,OrdTyp,StockNSt,ScanWk,ScanTrm,ScanRec Set ORDRec=^KOD(KLNr,"F",ORDNr,1) Set OLRec=^KOD(KLNr,"F",ORDNr,OLNr) Set PRNr=$P(OLRec,D,2),Aantal=$P(OLRec,D,3),OLUNr=$P(OLRec,D,15) Set OLevWk=$P(OLRec,D,25),TOENr=$P(OLRec,D,27),TLNr=$P(OLRec,D,28) ; KOM toelevering of STOCK ; IsKom = K : Kom toelevering maar toelevering gerecepteerd ; IsKom = T : Nog gekoppeld aan toeleveirng ; IsKom = W : Toelevering in WMS ; IsKom = "": Stock 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) .Set TLLevWk=$$CALCDATE^vhLib.DataTypes($$INTDATE^vhLib.DataTypes($P(R,D,25),"DW"),"W","LD") .If TLUNr,$D(^RCP("IT",TOENr,TLUNr)) Set IsKOM="W" ; Controle voorraad If IsKOM="" Do ;over Stock . Set ScanTrm=$$STOCKCTR(ORDNr,OLUNr,PRNr,Aantal,IsKOM,OLevWk) . Set ScanWk=$$STOCKCTR(ORDNr,OLUNr,PRNr,Aantal,IsKOM) Else Do ; over KOM-toelevering . Set (ScanTrm,ScanWk)="" . If IsKOM="T",TLLevWk<+$H Set ScanWk=5 ; toelevering te laat ; Opbouw scanrecord Set User=$P($P(ORDRec,D,8),"#"),OrdTime=$P($P(ORDRec,D,8),"#",3) Set:'OrdTime OrdTime=$$INTDATE^vhLib.DataTypes($P(ORDRec,D,2)) Set ScanRec="" Set $P(ScanRec,D,1)=KLNr Set $P(ScanRec,D,2)=Krediet Set $P(ScanRec,D,3)=PRNr Set $P(ScanRec,D,6)=$$INTDATE^vhLib.DataTypes($P(ORDRec,D,2)) ; Orderddatum Set $P(ScanRec,D,7)=$$INTDATE^vhLib.DataTypes($P(ORDRec,D,16)) ;Beloofd Set $P(ScanRec,D,8)=$P(ORDRec,D,25) ; OrdTyp Set $P(ScanRec,D,14)=Aantal ; Order aantal Set $P(ScanRec,D,16)=OLUNr#10>0 ; Is backorder Set $P(ScanRec,D,17)=$$LVWKDIFF(KLNr,ORDNr,OLNr) ; Leverdatum beoordeling Set $P(ScanRec,D,18)=$P(OLRec,D,25) ; Orderweek Set $P(ScanRec,D,20)=IsKOM Set $P(ScanRec,D,21)=$H ; Scan tijdstip Set $P(ScanRec,D,22)=$P(ScanWk,D,1) Set $P(ScanRec,D,23)=$P(ScanWk,D,2) Set $P(ScanRec,D,24)=$P(ScanTrm,D,1) Set $P(ScanRec,D,25)=$P(ScanTrm,D,2) ; Product gegevens Set R=^KPR(PRNr,1),StockNSt=$P(R,D,20) Set StockNSt=$S($D(^KPBI("D",KLNr,PRNr)):"C",1:$P("N\S",D,StockNSt+1)) Set $P(ScanRec,D,19)=StockNSt ; Stock, NietStock of Contract Set R=^KPR(PRNr,1) Set $P(ScanRec,D,26)=$P($P(R,D,23),"#")+$P($P(R,D,23),"#",2) ; Gem WVK Set R=^KPR(PRNr,0) Set $P(ScanRec,D,27)=$P($P(R,D,8),"#",2) ; ABCWaarde ; Order Set $P(ScanRec,D,28)=$P($P(ORDRec,D,8),"#") ; Gebruiker Quit ScanRec MERGSCAN(ORDNr,OLUNr,ScanRec) ; New ScanOld Set ScanOld=$G(^LEVPERF("O",ORDNr,OLUNr)) If $L(ScanOld) Do ; Conditioneel gegevens overdragen . ; Het kleinste verschil van de levertermijn . If $P(ScanOld,D,11)<$P(ScanRec,D,11) Set $P(ScanRec,D,11)=$P(ScanOld,D,11) . ; De grootste strafpunt ivm de scantermijn behouden . If $P(ScanOld,D,24)>$P(ScanRec,D,24) Set $P(ScanRec,D,24,25)=$P(ScanOld,D,24,25) . ; Indien de leverweek is aangebroken wordt de scanwk behouden . If +$P(ScanOld,D,21)'<$$CALCDATE^vhLib.DataTypes($H,"W","FD") Do ; Er is reeds gescanned geweest, de eerste behouden .. If $P(ScanOld,D,14)'>$$CALCDATE^vhLib.DataTypes($H,"W","LD") Do ; De levertermijn is voor deze of vorige weken, dan scan behouden ... Set $P(ScanRec,D,22,23)=$P(ScanOld,D,22,23) ; De grootste strafpunt ivm de scanwk behouden Quit ScanRec PUTSCAN(ORDNr,OLUNr,ScanRec) Set ^LEVPERF("O",ORDNr,OLUNr)=ScanRec Quit ; Opslaan dat de orderlijn op bon werd gezet ; Zodat ze 's nachts aan de statistiek kan worden toegevoegd STORE(KLNr,BONNr,ORDNr,OLNr,Geleverd,Krediet) New R,Aantal,BonRec Quit:Geleverd=0 Set R=^KOD(KLNr,"F",ORDNr,OLNr) Set Aantal=$P(R,D,3),OLUNr=$P(R,D,15) Set BonRec=KLNr_D_BONNr_D_Geleverd_D_Aantal_D_(Geleverd