TLLEVWK ;Toeleveringsweken [ 11/29/2003   8:10 AM ]
 Goto COMMAND
 
COMMAND ; Opdrachten lus
 Do INIT
 If $G(Extern),$L($G(ScrnTyp))
 Else  Do SELTYP Quit:ScrnTyp=""
 Do SELECT
 Kill Extern
 For  Quit:Input="-"!(Input=".")  Do
 .Do REFRESH
 .Do SL^PROC
 .If R'="COM" Set Input=R
 .Else  Set Input="" Do CALL^vhMenu("TLLEVWK")
 .Do EXEC^vhMenu("TLLEVWK",.Input)
 .If Input'="-",Input'="." Set Input=""
 Quit
 
EXTERN(ScrnTyp,LevNr,Week1,Week2,StKom,ListTyp) 
 New Extern
 Set Extern=1,ScrnTyp=$G(ScrnTyp),LevNr=$G(LevNr),ListTyp=$G(ListTyp)
 Set:ScrnTyp="V" VanWk=$G(Week1),TotWk=$G(Week2)
 Set:ScrnTyp="O" MaxWk=$G(Week1) Set:ScrnTyp="B" BevWk=$G(Week1)
 Set:ScrnTyp="L" MaxWk=$G(StKom)
 Goto COMMAND
 
INIT ;Initialisatie
 If '$D(Q) D
 .New ScrnTyp,LevNr,VanWk,TotWk,ListTyp,MaxWk,BevWk
 .D INIT^vhTERMINA
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Set (KScreen,PScreen)="O"
 Set ScrnTyp=$G(ScrnTyp)
 Set LevNr=$G(LevNr) If 'LevNr,LevNr'="." Set LevNr=5005
 Set VanWk=$G(VanWk)
 Set TotWk=$G(TotWk)
 Set ListTyp=$G(ListTyp) Set:ListTyp="" ListTyp="M"
 Set MaxWk=$G(MaxWk) Set:'MaxWk MaxWk=$$CALCDATE^vhLib.DataTypes($H,"W",-1)
 Set BevWk=$G(BevWk) Set:'BevWk BevWk=$$CALCDATE^vhLib.DataTypes($H,"W",-8)
 Set StKom=$G(StKom)
 If StKom'="S",StKom'="K" Set StKom="A"
 Set:'TotWk TotWk=$S(VanWk:VanWk,1:$$CALCDATE^vhLib.DataTypes($H,"W",+1))
 Set VanWk=$$CALCDATE^vhLib.DataTypes($H,"W",+1,"FD")
 Set TotWk=$$CALCDATE^vhLib.DataTypes($H,"W",+1,"LD")
 Set Input=""
 Write @F11,@F1
 Do ADD^vhScherm(1,1) Do REFRESH
 Quit
 
INITEXEC 
 New Field
 If ScrnTyp="V" Do
 .Set sFL(1)=LevNr_D_VanWk_D_TotWk_D_ListTyp
 .For Field=2,3,4,8 Do REMATTR^vhScherm(Field,"H","HD")
 Else  If ScrnTyp="O" Do
 .Set sFL(1)=LevNr_D_MaxWk_D_D_ListTyp
 .For Field=2,5,8 Do REMATTR^vhScherm(Field,"H","HD")
 Else  If ScrnTyp="B" Do
 .Set sFL(1)=LevNr_D_BevWk_D_D_ListTyp
 .For Field=2,6,8 Do REMATTR^vhScherm(Field,"H","HD")
 Else  If ScrnTyp="L" Do
 .Set sFL(1)=LevNr_D_StKom_D_D_ListTyp
 .For Field=2,7,8 Do REMATTR^vhScherm(Field,"H","HD")
 ;If '$D(SelTyp) Do PUTATTR^vhScherm(1,"","D")
 Quit
 
SAVEEXEC 
 If '$D(SelTyp) Do
 .If ScrnTyp="V" Set LevNr=$P(sFL(1),D),VanWk=$P(sFL(1),D,2),TotWk=$P(sFL(1),D,3),ListTyp=$P(sFL(1),D,4)
 .Else  If ScrnTyp="O" Set LevNr=$P(sFL(1),D),MaxWk=$P(sFL(1),D,2),ListTyp=$P(sFL(1),D,4)
 .Else  If ScrnTyp="B" Set LevNr=$P(sFL(1),D),BevWk=$P(sFL(1),D,2),ListTyp=$P(sFL(1),D,4)
 .Else  If ScrnTyp="L" Set LevNr=$P(sFL(1),D),StKom=$P(sFL(1),D,2),ListTyp=$P(sFL(1),D,4)
 Quit
 
SELTYP 
 New SelTyp
 Set SelTyp="",%SC=0
 Do DISPLAY^vhScherm("TLLEVWK","","","H")
 Do FIELD^vhScherm("TLLEVWK",1)
 Quit
 
SELECT ; Opvragen selectiecriteria
 Set:TotWk=9999999 TotWk=""
 If '$G(Extern) Do EDIT^vhScherm("TLLEVWK","","","H")
 If LevNr'=".",'LevNr Set Input="-" Quit
 Set:VanWk VanWk=$$CALCDATE^vhLib.DataTypes(VanWk,"W","FD")
 Set:TotWk (TotFWk,TotWk)=$$CALCDATE^vhLib.DataTypes(TotWk,"W","LD")
 Set:'TotWk TotFWk=9999999 
 Kill ^HULP(%J)
 Do INIT^PROC("TLLEVWK"_$S(ListTyp="Z":"Z",1:""),"TLLEVWK")
 Set LevNr=+LevNr
 Set MemTLNr="",(LastLev,MemLev)=LevNr Set:LevNr MemLev=$O(^KTO(LevNr),-1) Set:'LevNr LastLev=$O(^KTO(""),-1)
 Set TLLEVWK(9)=$$MORE(0,TLLEVWK(4))
 Do ADD^vhScherm(2,24)
 Quit
 
GEWICHT 
 New Next,R,PRNr,Aantal,StukGew,TotGew
 Set TLLEVWK(9)=$$MORE(TLLEVWK(9),999) ; Alles ophalen
 Set Next="",TotGew=0
 For  Set Next=$O(^HULP(%J,Next)) Quit:Next=""  Do
 .Set R=^HULP(%J,Next),PRNr=$P(R,D,8),Aantal=$P(R,D,11)
 .Quit:'PRNr  Quit:'$D(^KPR(PRNr))
 .Quit:$E($P(^KPR(PRNr,2),D,25))=7  ; Geen Identnrs beginnend met 7 (Brynzeel en Meubar)
 .Set R=^KPR(PRNr,1),StukGew=$P(R,D,13)/1000,TotGew=TotGew+(StukGew*Aantal)
 Set TotGew(1)=$$EXTNUM^vhLib.DataTypes(TotGew,0,".T",0)_"kg",R=$$WILD^vhTXTPOP("","Gewicht","TotGew")
 Quit
 
WAARDE 
 New Next,R,PRNr,Waarde,StukGew,TotWaa,Munt
 Quit:'$$ASK^vhWACHTW("PRODUKT",2401)
 Set TLLEVWK(9)=$$MORE(TLLEVWK(9),999) ; Alles ophalen
 Set Next="",TotWaa=0,Munt=$P(^KLE(^KL1(LevNr),0),D,11)
 For  Set Next=$O(^HULP(%J,Next)) Quit:Next=""  Do
 .Set R=^HULP(%J,Next),PRNr=$P(R,D,8),Waarde=$P(R,D,15)
 .Quit:'PRNr  Quit:'$D(^KPR(PRNr))
 .Quit:$E($P(^KPR(PRNr,2),D,25))=7  ; Geen Identnrs beginnend met 7 (Brynzeel en Meubar)
 .Set TotWaa=TotWaa+Waarde
 Set TotWaa(1)=$$EXTNUM^vhLib.DataTypes(TotWaa,0,".T",0)_Munt,R=$$WILD^vhTXTPOP("","Waarde","TotWaa")
 Quit
 
PRINT ; Afdrukken op laserprinter of printer
 New PL,LD,DL
 S TLLEVWK(11)="Toeleveringsweken "_$S(VanWk:"van "_$$EXTDATE^vhLib.DataTypes(VanWk,"DW")_" ",1:"")_$S(TotWk:"tot "_$$EXTDATE^vhLib.DataTypes(TotWk,"DW"),1:"") 
 S $P(TLLEVWK(11),D,2)=$S(LevNr:LevNr_" "_$P(^KLE(^KL1(LevNr),0),D,2),1:"")
 Set TLLEVWK(9)=$$MORE(TLLEVWK(9),999) ; Alles ophalen
 Merge PL=TLLEVWK
 Do:ListTyp="Z" INIT^PROC("TLLEVWKZP","PL")
 Do PRINT^OUTPUT(.PL,"MP")
 Do ADD^vhScherm(18,24)
 Quit
 
REFRESH ; Herstellen scherm
 ;If sRT=1 Write @F11,"Raadplegen Toeleveringsweken - "_QN,@F2 
 If sRT<3,sRB>1 Do DISPLAY^vhScherm("TLLEVWK","","","H")
 If sRB>2 Set DL(2)=sRT,DL(3)=sRB Do WL^PROC Kill DL(2),DL(3)
 Do RESET^vhScherm
 Quit
 
MORE(Max,Len,Ref) 
 New LevNr,Skip,KLNr,TLUNr
 Quit:MemTLNr=-1 Max
 Set LevNr=MemLev,TLNr=MemTLNr,Cnt=Max
 For  Quit:Max+Len'>Cnt  Set:TLNr="" LevNr=$O(^KTO(LevNr)) Quit:LevNr>LastLev!'LevNr  Do
 .For  Quit:Max+Len'>Cnt  Set TLNr=$O(^KTO(LevNr,TLNr)) Quit:TLNr=""  Do
 ..Set RecH=^KTO(LevNr,TLNr,1),TLLNr=100,KLNr=$P(RecH,D,9)
 ..If KLNr,$D(^BLBeri("K",KLNr)),$P(^BLBeri("K",KLNr),D,6)="DO" Quit
 ..Set KLNr=$P(RecH,D,8)
 ..If "B"[ScrnTyp Xecute "Set Skip=$$CHECK"_ScrnTyp_"()" Quit:Skip
 ..For  Set TLLNr=$O(^KTO(LevNr,TLNr,TLLNr)) Quit:TLLNr=""  Do
 ...Set RecL=^KTO(LevNr,TLNr,TLLNr)
 ...Set PRNr=$P(RecL,D,2),TLUNr=$P(RecL,D,15)
 ...Quit:'PRNr  ; Geen produkt
 ...If '$D(^KPR(PRNr,"J6332")) Quit:$D(^RCP("IT",TLNr,TLUNr))  ; In verwerking WMS, behalve voor HALUX
 ...If "VLO"[ScrnTyp Xecute "Set Skip=$$CHECK"_ScrnTyp_"()" Quit:Skip
 ...Set Rec=TLNr_D_TLLNr_D_$P(RecH,D,10)
 ...Set $P(Rec,D,4)=$P(RecL,D,27,28)_D_KLNr_D_$S(KLNr:$P(^KKL(^KK1(KLNr),0),D,2),1:"")
 ...Set $P(Rec,D,8)=PRNr_D_$P(^KPR(PRNr,0),D,1)_D_$P(^KPR(PRNr,1),D,20)
 ...Set $P(Rec,D,11)=$P(RecL,D,3)_D_$P(RecL,D,25)_D_$P(RecL,D,29)_D_$P(RecL,D,24)_D_$P(RecL,D,9)
 ...Set Cnt=Cnt+1
 ...Set ^HULP(%J,Cnt)=Rec
 Set MemLev=LevNr,MemTLNr=TLNr,Max=Cnt
 If LevNr>LastLev!'LevNr,TLNr="" Set MemTLNr=-1 
 Quit Max
 
CHECKV() 
 New LevWk,Skip
 Set Skip=1,LevWk=$$INTDATE^vhLib.DataTypes($P(RecL,D,25),"DW")
 If LevWk'<VanWk,LevWk'>TotFWk Set Skip=0
 Quit Skip
 
CHECKO() 
 New LevWk,Skip
 Set Skip=1,LevWk=$$INTDATE^vhLib.DataTypes($P(RecL,D,25),"DW")
 If LevWk'>MaxWk Set Skip=0
 Quit Skip
 
CHECKB() 
 New LevWk,Skip
 Set Skip=1
 If $P(RecH,D,10)="" Do
 .Set LevWk=$$INTDATE^vhLib.DataTypes($P(RecH,D,2))
 .If LevWk'>BevWk Set Skip=0
 Quit Skip
 
CHECKL() 
 New Skip,IsStock
 Set Skip=1,IsStock=$P(^KPR(PRNr,1),D,20)
 If $P("K\S",D,IsStock+1)=StKom!(StKom="A"),$L($P(RecL,D,24)) Set Skip=0
 Quit Skip
 
RPLPR(Input) 
 New Param
 Quit:'TLLEVWK(6)
 Set Rec=$G(^HULP(%J,TLLEVWK(6)))
 Quit:'$P(Rec,D,8)
 Set Param="O"
 Set $P(Param,D,6)="OOT"_U_$P(Rec,D,1)_U_$P(Rec,D,2)
 If Input="T" Set PScreen=$$RAADPL^PRODUKT($P(Rec,D,8),Param)
 If Input="P" Set PScreen=$$RAADPL^PRODUKT($P(Rec,D,8),$P(PScreen,D,1))
 Do ADD^vhScherm(1,24)
 Quit
  
RPLKL(Input)   
 New Param
 Quit:'TLLEVWK(6)
 Set Rec=$G(^HULP(%J,TLLEVWK(6)))
 Quit:'$P(Rec,D,6)
 Set Param="O"
 Set $P(Param,D,6)="OOT"_U_$P(Rec,D,1)_U_$P(Rec,D,2)
 If Input="K" Set KScreen=$$RAADPL^KLANT($P(Rec,D,6),$P(KScreen,D,1))
 Do ADD^vhScherm(1,24)
 Quit
  
DELMARK 
 New LevNr,TLNr,TLLNr,Rec
 Quit:'TLLEVWK(6)
 Set Rec=$G(^HULP(%J,TLLEVWK(6)))
 Quit:$P(Rec,D,14)'="M"
 Set $P(Rec,D,14)="",^HULP(%J,TLLEVWK(6))=Rec
 Do EL^PROC
 Set TLNr=$P(Rec,D),TLLNr=$P(Rec,D,2),LevNr=$P($G(^KTO1(TLNr)),D)
 If LevNr,$D(^KTO(LevNr,TLNr,TLLNr)),$P(^KTO(LevNr,TLNr,TLLNr),D,24)="M" Set $P(^KTO(LevNr,TLNr,TLLNr),D,24)=""
 Quit
  
MAIL ; Controle op Toeleveringen 
 Quit:$$CALCDATE^vhLib.DataTypes($H,"A","+0")'=+$H
 Lock +TLLEVWK:1 Else  Quit
 Hang 120 ; Verhinderen van het dubbelopstarten van QCTK0
 Do MAILAB
 Do:$$EXTDATE^vhLib.DataTypes($H,"DWN")=1 MAILOUD ;Maandagmorgen
 Do MAILGLT
 Lock -TLLEVWK
 Quit
 
MAILAB ; Controle op Toeleveringen ofdat na 5 dagen het ABNr is ingevuld
 New
 Do INIT^vhTERMINA
 Set LevNr=0
 For  Set LevNr=$O(^KTO(LevNr)) Quit:LevNr=""  Do
 .Quit:LevNr=5005  ; BLUM wordt behandeld door BLKAL
 .Quit:LevNr=6332  ; HALUX geen AB controle
 .Set CompDate=$$CALCDATE^vhLib.DataTypes($H,"A",-5)
 .Lock +^KTO(LevNr)
 .Kill Txt,Lnk  Set Lnk=""
 .Set TLNr=""
 .For  Set TLNr=$O(^KTO(LevNr,TLNr)) Quit:TLNr=""  Do
 ..Set Rec=^KTO(LevNr,TLNr,1)
 ..If $P(Rec,D,17)="" Set Date=$$INTDATE^vhLib.DataTypes($P(Rec,D,2),"DK") ; Kreatie datum
 ..Else  Set Date=$P(Rec,D,17)
 ..Quit:CompDate'>Date  ; Controle datum nog niet verstreken
 ..Quit:$L($P(Rec,D,10))  ; ABNummer is reeds ingevuld
 ..Set $P(Rec,D,17)=+$H ; Controle datum is huidige datum
 ..Set ^KTO(LevNr,TLNr,1)=Rec
 ..If '$D(Txt) Set Txt=1,Txt(1)="Volgende toeleveringen hebben nog geen bevestiging~~ŞUToelevering    Datum Şu"
 ..Set Txt=Txt+1,Txt(Txt)="~  "_$E(TLNr,1,3)_"."_$E(TLNr,4,6)_"    "_$P(Rec,D,2)
 ..Set Lnk=Lnk+1,Lnk(Lnk)="TL\"_TLNr_"\W"
 .Lock -^KTO(LevNr)
 .Quit:'$D(Txt)
 .Set MailId=$$SYSTEM^vhMAIL("LE",LevNr,"Ontbrekende opdrachtbevestigingen","TLLEVWK",.Txt,.Lnk,"","A")
 Quit
 
MAILOUD ; Nakijken of er OUDE toeleveringen zijn
 New
 Do INIT^vhTERMINA
 Set Delta=0 ; Aantal weken
 Set LevNr=0
 For  Set LevNr=$O(^KTO(LevNr)) Quit:LevNr=""  Do
 .Quit:LevNr=5005  ; BLUM wordt behandeld door BLKAL
 .Kill Txt,Lnk  Set Lnk=""
 .Set TLNr=""
 .For  Set TLNr=$O(^KTO(LevNr,TLNr)) Quit:TLNr=""  Do
 ..Set Rec=^KTO(LevNr,TLNr,1)
 ..Set TLLNr=99
 ..Set PRCnt=""
 ..For  Set TLLNr=$O(^KTO(LevNr,TLNr,TLLNr)) Quit:TLLNr=""  Do
 ...Set LRec=^KTO(LevNr,TLNr,TLLNr)
 ...Quit:$P(LRec,D,17)="KTO11"  ; Tekstlijn
 ...Set PRCnt=PRCnt+1 ; Produktlijn
 ...Quit:$$INTDATE^vhLib.DataTypes($P(LRec,D,25),"DW")>($H-(7*Delta))
 ...If '$D(Txt) Set Txt=1,Txt(1)="Volgende toeleveringen hebben OUDE leveringsdatums~~ŞUToelevering    Datum Şu"
 ...Set Txt=Txt+1,Txt(Txt)="~  "_$E(TLNr,1,3)_"."_$E(TLNr,4,6)_"    "_$P(Rec,D,2)
 ...Set Lnk=Lnk+1,Lnk(Lnk)="TL\"_TLNr_"\W"
 ...Set TLLNr=9999
 ..;If 'PRCnt Do  ; Verwijderen van toelevering, met alleen tekstlijnen
 ...;Write !,LevNr," ",TLNr," ",$P(Rec,D,2) r k
 ...;Lock +^KTO(LevNr)
 ...;Do DELOBJ^FLOWTOE(TLNr)
 ...;Lock -^KTO(LevNr)
 .Quit:'$D(Txt)
 .Set MailId=$$SYSTEM^vhMAIL("LE",LevNr,"Oude toeleveringen","TLLEVWK",.Txt,.Lnk,"","A")
 Quit
 
MAILGLT ; Nakijken of er GEWIJZIGDE levertermijnen zijn
 New
 Do INIT^vhTERMINA
 Set LevNr=0
 For  Set LevNr=$O(^KTO(LevNr)) Quit:LevNr=""  Do
 .Kill TxtStock,TxtKom,LnkStock,LnkKom  Set (LnkStock,LnkKom)=""
 .Set TLNr=""
 .For  Set TLNr=$O(^KTO(LevNr,TLNr)) Quit:TLNr=""  Do
 ..Kill Stock,Kom
 ..Set Rec=^KTO(LevNr,TLNr,1)
 ..Set TLLNr=99
 ..Set PRCnt=""
 ..For  Set TLLNr=$O(^KTO(LevNr,TLNr,TLLNr)) Quit:TLLNr=""  Do
 ...Set LRec=^KTO(LevNr,TLNr,TLLNr)
 ...Quit:$P(LRec,D,17)="KTO11"  ; Tekstlijn
 ...Quit:$P(LRec,D,24)'="G"
 ...Set PRCnt=PRCnt+1 ; Gewijzigde lijn
 ...Set $P(LRec,D,24)="M",^KTO(LevNr,TLNr,TLLNr)=LRec,PRNr=$P(LRec,D,2)
 ...If PRNr Set @$P("Kom\Stock",D,$P(^KPR(PRNr,1),D,20)+1)=1
 ..Quit:'PRCnt
 ..If $G(Stock) Do
 ...If '$D(TxtStock) Set TxtStock=1,TxtStock(1)="Volgende toeleveringen hebben GEWIJZIGDE leveringstermijnen~~ŞUToelevering    Datum Şu"
 ...Set TxtStock=TxtStock+1,TxtStock(TxtStock)="~  "_$E(TLNr,1,3)_"."_$E(TLNr,4,6)_"    "_$P(Rec,D,2)
 ...Set LnkStock=LnkStock+1,LnkStock(LnkStock)="TL\"_TLNr_"\W"
 ..If $G(Kom) Do
 ...If '$D(TxtKom) Set TxtKom=1,TxtKom(1)="Volgende toeleveringen hebben GEWIJZIGDE leveringstermijnen~~ŞUToelevering    Datum Şu"
 ...Set TxtKom=TxtKom+1,TxtKom(TxtKom)="~  "_$E(TLNr,1,3)_"."_$E(TLNr,4,6)_"    "_$P(Rec,D,2)
 ...Set LnkKom=LnkKom+1,LnkKom(LnkKom)="TL\"_TLNr_"\W"
 .If $D(TxtStock) Do
 ..Set LnkStock=LnkStock+1,LnkStock(LnkStock)="TLLEVWK\S\R"
 ..Set MailId=$$SYSTEM^vhMAIL("LE",LevNr,"Gewijzigde leveringstermijnen","TLLEVWK",.TxtStock,.LnkStock,"","A")
 .If $D(TxtKom) Do
 ..Set LnkKom=LnkKom+1,LnkKom(LnkKom)="TLLEVWK\K\R"
 ..Set MailId=$$SYSTEM^vhMAIL("LE",LevNr,"Gewijzigde leveringstermijnen","TLLEVWK",.TxtKom,.LnkKom,"","A")
 Quit