EWRCPS ;E'WMS Selecteren toelevering voor receptie [ 01/13/2003  1:08 PM ]
 ;
 Do VERWERK()
 Quit
VERWERK(LEVNr,TOENr) 
 New Input,Detail,AD,Lines,Selected,RCPNr,RCPDate,RCPVRef,RCPBRef,ABNr,Refer,Receive,Extern,ModHalux
 Set LEVNr=$G(LEVNr),TOENr=$G(TOENr)
 Set Extern=0 If LEVNr,TOENr,$D(^KTO(LEVNr,TOENr)) Set Extern=1
 Do INIT Quit:'LEVNr!'RCPNr
 For  Do REFRESH,COMMAND Quit:Input="CANC"  If Input="SAVE" Do  Quit:$L(Input)
 .If '$D(Receive),Extern
 .Else  Do
 ..If Extern,LEVNr=6332 Set Input="J"
 ..Else  Set Input=$$^vhTXTPOP("FILE",$S($D(Receive):"SAVE",1:"EXIT"))
 .If Input="J",$D(Receive) Do SAVE(TOENr,.Receive)
 Do SENDWMS
 Quit
 ;
COMMAND 
 If Extern,LEVNr=6332,'$G(ModHalux) Set Input="A"
 Else  Do
 .Set Input=$$SCROLL^vhLIST(.AD)
 .If Input="COM" Set Input="" Do CALL^vhMenu("EWRCPS")
 .If Input="SPEC" Set Input="" Do CALLSPEC^vhMenu(AD("POS")+AD("SELECT")_";80","EWRCPSS","E")
 Quit:Input=""
 Do EXEC^vhMenu("EWRCPS",.Input)
 If Extern,LEVNr=6332 Do
 .If Input="SAVE" Quit:'$D(Receive)  Set ModHalux=0
 .Quit:$G(ModHalux)
 .Set Input=$$^vhTXTPOP("EWRCPS","MODHALUX")
 .If Input="A" Set Input="CANC"
 .Else  If Input="V" Set Input="SAVE" Kill ModHalux
 .Else  Set ModHalux=1
 Quit
 ;
TOENR(Input) 
 New %TC,T,L,R
 If 'Extern,Input'="O" Set T=$O(^KTO(LEVNr,TOENr),Input) Write:T="" *7
 Else  Do
 .Set LEVNr=$G(LEVNr),TOENr=$G(TOENr) Set:LEVNr L("L")=LEVNr,L("N")=1 Set:TOENr T(TOENr)=""
 .If Extern Set T=TOENr Quit
 .Do STORE^vhTERMINA()
 .Xecute "Set T=$$SELECT^FLOW(""KTO"",""KTO1"",1"_$S(LEVNr:",.T,.L",1:"")_")"
 .Do REFRESH^vhTERMINA()
 If 'Extern,T=$G(TOENr) Set T="-"
 Quit:'T
 If $D(TOENr) Do
 .If $D(Receive) Do SAVE(TOENr,.Receive)
 .Do REMOVE^vhLock("^KTO(LEVNr,TOENr)")
 Set TOENr=T
 For  Do ADD^vhLock("^KTO(LEVNr,TOENr)") Quit:%TC  Do LDISP^vhLock("^KTO(LEVNr,TOENr)","Toelevering "_TOENr)
 Set:'LEVNr LEVNr=$P(^KTO1(TOENr),D)
 Set R=^KTO(LEVNr,TOENr,1),Refer=$P(R,D,3),(RCPBRef,ABNr)=$P(R,D,10)
 Do INIT^vhLIST("EWRCPS","LIST",.AD),FETCHDET,ADD^vhScherm(1,24)
 Kill Receive
 Quit
 ;
AANTAL(Input,Select) 
 New R,FromLine,ToLine,Line,TLUNr,TLNr,PRNr,Aantal
 Set Input=$G(Input),Select=$G(Select)
 If 'Select Set FromLine=$O(Detail("")),ToLine=$O(Detail(9999),-1)
 Else  Set (FromLine,ToLine)=Select
 Set Line=$O(Detail(FromLine),-1)
 For  Set Line=$O(Detail(Line)) Do  Quit:Line=ToLine
 .Set TLNr=Detail(Line),R=^KTO(LEVNr,TOENr,TLNr)
 .Set PRNr=$P(R,D,2),Aantal=$P(R,D,3),TLUNr=$P(R,D,15)
 .Quit:$$OPSLMAN^PRODUKT2(PRNr)
 .If $D(^RCP("IT",TOENr,TLUNr)) Write:Select *7 Quit
 .If 'PRNr,'Select Quit
 .If Input'="W",'$D(Receive(TLUNr)) Set Receive(TLUNr)="",Selected=Selected+1
 .If Input="W" Quit:'$D(Receive(TLUNr))  Kill Receive(TLUNr)
 .Else  If "V"'[Input Do
 ..Do STORE^vhTERMINA(),DISPLAY^vhScherm("EWRCPSA")
 ..If Input'="B" Do FIELD^vhScherm("EWRCPSA","QTYLEVERD")
 ..If Input="B" Do FIELD^vhScherm("EWRCPSA","QTYBACK")
 ..Do RESET^vhScherm,REFRESH^vhTERMINA()
 .Else  If PRNr Set Receive(TLUNr)=$P(R,D,3)
 .If $TR($G(Receive(TLUNr)),"\0","")="" Kill Receive(TLUNr) Set Selected=Selected-1
 .If Select Do
 ..If Input'="V",Input'="ENTER" Do LINE^vhLIST(.AD,AD("SELECT")) Quit
 ..Do MOVE^vhLIST(.AD,"DO",1)
 If 'Select Do WRITE^vhLIST(.AD)
 Do DISPLAY^vhScherm("EWRCPSH","","","","LIJNEN")
 Quit
 ;
DETAIL(Select) 
 New R,TLUNr,TLNr,PRNr,Aantal
 Set TLNr=Detail(Select)
 Set R=^KTO(LEVNr,TOENr,TLNr),PRNr=$P(R,D,2),Aantal=$P(R,D,3),TLUNr=$P(R,D,15)
 Do STORE^vhTERMINA(),DISPLAY^vhScherm("EWRCPSD"),RESET^vhScherm,REFRESH^vhTERMINA()
 Quit
 ;
TOELEV 
 New Locals
 Set Locals("TOENr")=TOENr,Locals("Extern")=1
 Do DO^vhPROGRAM("FTE^KTO30"),INIT^vhLIST("EWRCPS","LIST",.AD),FETCHDET,ADD^vhScherm(1,24)
 Quit
 ;
ORDER 
 New R,TLNr,ORDNr,Locals
 Set TLNr=Detail(AD("SELECT")),R=^KTO(LEVNr,TOENr,TLNr),ORDNr=$P(R,D,27) Quit:'ORDNr
 Set Locals("ORDNr")=ORDNr,Locals("Extern")=1
 Do DO^vhPROGRAM("FOE^KF9"),INIT^vhLIST("EWRCPS","LIST",.AD),FETCHDET,ADD^vhScherm(1,24)
 Quit
 ;
RPLPR 
 New R,PR
 Quit:'$D(Detail)
 Set R=^KTO(LEVNr,TOENr,Detail(AD("SELECT"))),PR=$P(R,D,2) Quit:'PR
 Goto RPLPR^FLOW
 ;
KILLKOML 
 New %TC,R,TLNr,PRNr,KLNr,ORDNr,OLNr,Aantal,FysStock,ResStock,PraStock,Taal
 Set TLNr=Detail(AD("SELECT")),R=^KTO(LEVNr,TOENr,TLNr),PRNr=$P(R,D,2),ORDNr=$P(R,D,27),OLNr=$P($P(R,D,28),";")
 Quit:'PRNr!'ORDNr
 Quit:'$D(^KO1(ORDNr,"F"))
 Set KLNr=$P(^KO1(ORDNr,"F"),D),R=^KKL(^KK1(KLNr),0),Taal=$P(R,D,9) Set:Taal="" Taal="N"
 Set R=^KOD(KLNr,"F",ORDNr,OLNr),Aantal=$P(R,D,3)
 Set R=^KPR(PRNr,0),FysStock=$P(R,D,14),R=^KPR(PRNr,2),ResStock=$P(R,D,9),PraStock=FysStock-ResStock+Aantal
 If Aantal'>PraStock Set R=$$^vhTXTPOP("EWRCPS","KILLKOML")
 If Aantal>PraStock Do
 .Set FysStock=$$EXTNUM^vhDTyp(FysStock,8,"T.",0)
 .Set PraStock=$$EXTNUM^vhDTyp(PraStock,8,"T.",0)
 .Set R=$$^vhTXTPOP("EWRCPS","KOMSTOCK","",FysStock,PraStock,$$EXTNUM^vhDTyp(Aantal,8,"T.",0))
 Quit:R'="V"
 For  Do ADD^vhLock("^KPR(PRNr)") Quit:%TC  Do LDISP^vhLock("^KPR(PRNr)","Produkt "_$P(^KPR(PRNr,0),D))
 Do KWNODE^FLOWTOE(LEVNr,TOENr,TLNr)
 Do InvoerUitvoerLinkVerbroken^FLOWTOE2(LEVNr,TOENr,TLNr)
 Set Rec=^KTO(LEVNr,TOENr,TLNr),$P(Rec,D,27,28)=D,^KTO(LEVNr,TOENr,TLNr)=Rec
 Do SWNODE^FLOWTOE(LEVNr,TOENr,TLNr)
 For  Do ADD^vhLock("^KOD(KLNr,""F"",ORDNr)") Quit:%TC  Do LDISP^vhLock("^KOD(KLNr,""F"",ORDNr)","Order "_ORDNr)
 Do KWNODE^FLOWORD(KLNr,ORDNr,OLNr)
 Set Rec=^KOD(KLNr,"F",ORDNr,OLNr),$P(Rec,D,27,28)=D,^KOD(KLNr,"F",ORDNr,OLNr)=Rec
 Do SWNODE^FLOWORD(KLNr,ORDNr,OLNr)
 Kill ^KTOK(LEVNr,TOENr,TLNr)
 Do REMOVE^vhLock("^KOD(KLNr,""F"",ORDNr)")
 Do REMOVE^vhLock("^KPR(PRNr)")
 Do LINE^vhLIST(.AD,AD("SELECT"))
 Quit
 ;
REFRESH 
 If sRT<$P(AD("POS"),";") Do DISPLAY^vhScherm("EWRCPSH")
 If sRT<($P(AD("POS"),";")+$P(AD("POS"),";",3)) Do WRITE^vhLIST(.AD)
 DO RESET^vhScherm
 Quit
 ;
 ; Ophalen detail
FETCHDET 
 New R,TLNr,Count,PRNr,TLUNr
 Kill Detail
 Set TLNr=100,(Count,Lines,Selected)=0
 For  Set TLNr=$O(^KTO(LEVNr,TOENr,TLNr)) Quit:TLNr=""  Do
 .Set Count=Count+1,Detail(Count)=TLNr,R=^KTO(LEVNr,TOENr,TLNr),PRNr=$P(R,D,2),TLUNr=$P(R,D,15)
 .If PRNr Set Lines=Lines+1 If $D(Receive(TLUNr)) Set Selected=Selected+1
 Quit
 ;
INIT 
 Do INIT^vhLIST("EWRCPS","LIST",.AD)
 Set (ABNr,Refer,RCPNr,RCPDate,RCPVRef,RCPBRef)="" Set:'Extern (LEVNr,TOENr)=""
 If 'Extern Do  Quit:'LEVNr
 .Do ADD^vhScherm(1,24),REFRESH
 .Set LEVNr=$$SELECT^LEVER(1)
 Else  Do TOENR("")
 Do ADD^vhScherm(1,24),REFRESH
 Do RCPNR Quit:'RCPNr
 Do ADD^vhScherm(1,24),REFRESH
 Quit:Extern
 Do TOENR("O")
 Set:'TOENr LEVNr=""
 Quit
 ;
RCPNR 
 If Extern,LEVNr=6332 Set RCPNr="N"
 Else  Set RCPNr=$$SELECT^EWRCP("L",LEVNr," WP",,"N")
 Quit:"-"[RCPNr
 If RCPNr="N" Do
 .Set RCPNr=$$NEXTID^EWRCP
 .Set RCPDate=$H
 .If Extern,LEVNr=6332 Quit
 .Do FIELD^vhScherm("EWRCPSH","RCPDATE")
 .Do FIELD^vhScherm("EWRCPSH","RCPVREF")
 Else  Do
 .Set Rec=^RCP("D",RCPNr)
 .Set RCPDate=$P(Rec,D,4)
 .Set RCPVRef=$P(Rec,D,3)
 Do DISPLAY^vhScherm("EWRCPSH","","","","RCPNR;RCPDATE;RCPVREF")
 Quit
 ;
EDITBREF ; Wijzigen leveranciers bonreferentie
 Do FIELD^vhScherm("EWRCPSH","RCPBREF")
 Do DISPLAY^vhScherm("EWRCPSH","","","","RCPBREF")
 Quit
 
SAVE(TOENr,Receive) ; Overbrengen RCP
 ; Receive bevat: Piece 1 = RCPAantal, Piece 2 = Backorder aantal
 New RecLoc
 Quit:'$D(Receive)
 If Extern,LEVNr=6332
 Else  Do EDITBREF
 Merge RecLoc(TOENr)=Receive ; Door te geven referentie moet ook TOENr bevatten
 Do QCSTAT(.RecLoc,RCPNr)
 Do BLDRCP^EWRCPS2(LEVNr,TOENr,$NA(RecLoc),RCPNr,RCPDate,RCPVRef,RCPBRef)
 Quit
 
SENDWMS New IsSend
 Quit:$D(^RCP("D",RCPNr))'=11
 Set IsSend=$P($G(^RCP("D",RCPNr)),D,20)'="" ; Als de Receptie nog niet is verstuurd dan wachten met versturen tot alles klaar is.
 If IsSend Do  ; indien verstuurd dan onmiddellijk terug opsturen
 .Do SEND^EWRCPSW(RCPNr)
 Else  Do
 .If Extern,LEVNr=6332 Set Inp="V"
 .Else  Set Inp=$$^vhTXTPOP("EWRCPS","SENDWMS")
 .Do:Inp="V" SEND^EWRCPSW(RCPNr)
 Quit
 
QCSTAT(RecLoc,RCPNr) 
 New R,%TC,LEVNr,TOENr,TTOENr,TLUNr,TLNr,PRNr,KPRNr,QCStatPM,KQCStatPM,QCStatOV,KQCStatOV,QCStatOVStock
 New TUserId,MailPM,MailOV,Text,Ref,TCnt,RCnt,Aantal,BackOrd,MailId,IsStock
 Set RCPNr=$G(RCPNr),TOENr=""
 For  Set TOENr=$O(RecLoc(TOENr)) Quit:TOENr=""  Do
 .Set R=^KTO1(TOENr),LEVNr=$P(R,D),TLUNr=""
 .For  Set TLUNr=$O(RecLoc(TOENr,TLUNr)) Quit:TLUNr=""  Do
 ..Set TLNr=^TO("IU",TOENr,TLUNr)
 ..Set R=^KTO(LEVNr,TOENr,TLNr),PRNr=$P(R,D,2)
 ..Quit:'PRNr
 ..Set R=^KPR(PRNr,1),QCStatOV=$E($P($P(R,D,12),";")),QCStatOVStock=$E($P($P(R,D,12),";"),3),QCStatPM=$E($P($P(R,D,12),";",2)),IsStock=$P(R,D,20)
 ..Do:$D(^PRLINK("D",PRNr))
 ...Set KPRNr=""
 ...For  Set KPRNr=$O(^PRLINK("D",PRNr,KPRNr)) Quit:KPRNr=""  Do
 ....Set R=^KPR(KPRNr,1),KQCStatOV=$E($P($P(R,D,12),";")),KQCStatPM=$E($P($P(R,D,12),";",2))
 ....Set:$A(KQCStatPM)>$A(QCStatPM) QCStatPM=KQCStatPM
 ....Set:$A(KQCStatOV)>$A(QCStatOV) QCStatOV=KQCStatOV
 ..Set:QCStatOV="C" QCStatOVStock=""
 ..Do:"\B\C\"[(D_QCStatPM_D)
 ...Do:QCStatPM="B"
 ....Do MQCSTATPM(PRNr)
 ....Do:$D(^PRLINK("D",PRNr))
 .....Set KPRNr=""
 .....For  Set KPRNr=$O(^PRLINK("D",PRNr,KPRNr)) Quit:KPRNr=""  Do MQCSTATPM(KPRNr)
 ...Set MailPM("PMRCP",TOENr,TLNr)=PRNr_D_RecLoc(TOENr,TLUNr)
 ..Do:"\B\C\"[(D_QCStatOV_D)
 ...Do:QCStatOV="B"
 ....Do MQCSTATOV(PRNr)
 ....Do:$D(^PRLINK("D",PRNr))
 .....Set KPRNr=""
 .....For  Set KPRNr=$O(^PRLINK("D",PRNr,KPRNr)) Quit:KPRNr=""  Do MQCSTATOV(KPRNr)
 ...If QCStatOVStock="S",'IsStock Quit
 ...Set MailOV(TOENr,TLNr)=PRNr_D_RecLoc(TOENr,TLUNr)
 Do:$D(MailPM)
 .Set TUserId=""
 .For  Set TUserId=$O(MailPM(TUserId)) Quit:TUserId=""  Do
 ..Kill Text,Ref
 ..Set TCnt=0
 ..Set TCnt=TCnt+1,Text(TCnt)="Gelieve de ontvangst van volgend(e) produkt(en) na te zien:"
 ..Set:RCPNr TCnt=TCnt+1,Text(TCnt)="~~Receptie "_$$EXTNUM^vhDTyp(RCPNr,0,".",0)
 ..Set TCnt=TCnt+1,Text(TCnt)="~~ªUToelev  | Korttekst                 |   Aantal |  Backordªu"
 ..Set RCnt=0
 ..Set:RCPNr RCnt=RCnt+1,Ref(RCnt)="EWRCPST\"_RCPNr_"\W"
 ..Set TOENr=""
 ..For  Set TOENr=$O(MailPM(TUserId,TOENr)) Quit:TOENr=""  Do
 ...Set:RCPNr RCnt=RCnt+1,Ref(RCnt)="TL\"_TOENr_"\W"
 ...Set TTOENr=$$EXTNUM^vhDTyp(TOENr,0,".T",0),TLNr=""
 ...For  Set TLNr=$O(MailPM(TUserId,TOENr,TLNr)) Quit:TLNr=""  Do
 ....Set R=MailPM(TUserId,TOENr,TLNr),PRNr=$P(R,D),Aantal=$P(R,D,2),BackOrd=$P(R,D,3)
 ....Set TCnt=TCnt+1,Text(TCnt)="~"_TTOENr_"|"_$J($P(^KPR(PRNr,0),D),26)_" |"
 ....Set Text(TCnt)=Text(TCnt)_$$EXTNUM^vhDTyp(Aantal,10,".T",0)_"|"_$$EXTNUM^vhDTyp(BackOrd,10,".T",0)
 ....Set RCnt=RCnt+1,Ref(RCnt)="PR\"_PRNr_"\R\O"
 ..Set MailId=$$SYSTEM^vhMAIL("","Ontvangst goederen","Controle",TUserId,.Text,.Ref,1,1)
 Do:$D(MailOV)
 .Kill Text,Ref
 .Set TCnt=0
 .Set TCnt=TCnt+1,Text(TCnt)="Volgend(e) produkt(en) zijn ontvangen maar moeten nog gestockeerd worden:"
 .Set:RCPNr TCnt=TCnt+1,Text(TCnt)="~~Receptie "_$$EXTNUM^vhDTyp(RCPNr,0,".",0)
 .Set TCnt=TCnt+1,Text(TCnt)="~~ªUToelev  | Korttekst                 |   Aantal |  Backordªu"
 .Set RCnt=0
 .Set TOENr=""
 .For  Set TOENr=$O(MailOV(TOENr)) Quit:TOENr=""  Do
 ..Set TTOENr=$$EXTNUM^vhDTyp(TOENr,0,".T",0),TLNr=""
 ..For  Set TLNr=$O(MailOV(TOENr,TLNr)) Quit:TLNr=""  Do
 ...Set R=MailOV(TOENr,TLNr),PRNr=$P(R,D),Aantal=$P(R,D,2),BackOrd=$P(R,D,3)
 ...Set TCnt=TCnt+1,Text(TCnt)="~"_TTOENr_"|"_$J($P(^KPR(PRNr,0),D),26)_" |"
 ...Set Text(TCnt)=Text(TCnt)_$$EXTNUM^vhDTyp(Aantal,10,".T",0)_"|"_$$EXTNUM^vhDTyp(BackOrd,10,".T",0)
 ...Set RCnt=RCnt+1,Ref(RCnt)="PR\"_PRNr_"\R\O"
 .Set MailId=$$SYSTEM^vhMAIL("","Ontvangst goederen","","OV",.Text,.Ref,1,1)
 Quit
 
 ; Producmanagement
MQCSTATPM(PRNr) 
 New %TC,R
 For  Do ADD^vhLock("^KPR(PRNr)") Quit:%TC  Do LDISP^vhLock("^KPR(PRNr)","Produkt "_$P(^KPR(PRNr,0),D))
 Set R=^KPR(PRNr,1),$P(R,D,12)=$P($P(R,D,12),";"),^KPR(PRNr,1)=R
 Do REMOVE^vhLock("^KPR(PRNr)")
 Quit
 
 ; Orderverwerking
MQCSTATOV(PRNr) 
 New %TC,R
 For  Do ADD^vhLock("^KPR(PRNr)") Quit:%TC  Do LDISP^vhLock("^KPR(PRNr)","Produkt "_$P(^KPR(PRNr,0),D))
 Set R=^KPR(PRNr,1),$P(R,D,12)=""_$S($L($P($P(R,D,12),";",2)):";"_$P($P(R,D,12),";",2),1:""),^KPR(PRNr,1)=R
 Do REMOVE^vhLock("^KPR(PRNr)")
 Quit
 
HALUX 
 New TOENr,LEVNr,DERDE,ABNr,Refer,RCPNr,RCPDate,RCPVRef,RCPBRef,Extern
 Set LEVNr=6332,Extern=1
 Do INIT^vhLIST("EWRCPS","LIST",.AD)
 Set (ABNr,Refer,RCPNr,RCPDate,RCPVRef,RCPBRef,TOENr)=""
 Do ADD^vhScherm(1,24),REFRESH
 Set DERDE("L")=LEVNr,DERDE("N")=1
 For  Set TOENr=$$SELECT^FLOW("KTO","KTO1",1,.T,.DERDE,,0) Quit:'TOENr  Do
 .Do VERWERK(LEVNr,TOENr)
 .Do REMOVE^vhLock("^KTO(LEVNr,TOENr)")
 Quit
 ;
TUSERID(PRNr)
 New I,R,TUserId,HKKey,GKKey,SKKey
 Set TUserId=""
 Set I=$O(^KPR(PRNr,"I"))
 Do:$E(I)="I"
 . Set R=^KPR(PRNr,I),SKKey=$P(R,D,4)
 . Set R=^KLAS("K",SKKey),TUserId=$P(R,D,13)
 . Do:'TUserId
 . . Set GKKey=$P(R,D,9)
 . . Set R=^KLAS("K",GKKey),TUserId=$P(R,D,13)
 . . Do:'TUserId
 . . . Set HKKey=$P(R,D,8)
 . . . Set R=^KLAS("K",HKKey),TUserId=$P(R,D,13)
 Quit TUserId
 ;