EWRCP ;E'WMS Receptie [ 02/19/2002  3:25 PM ]
NEXTID() New RCPNr
 Set RCPNr=$G(^RCP("N"),100000)+1
 Set ^RCP("N")=RCPNr
 Quit RCPNr
 
 ; Optie : N = Nieuw nummer toegelaten
 ;         L = Enkel de opgegeven leverancier is mogelijk
SELECT(ObjType,ObjRef,WStat,PStat,Optie) 
 ;WMS Stat : String van toegelaten statussen, status:leeg wordt doorgegeven als een blanko
 ;Probleem Stat : String van toegelaten probleemstatussen, probleemstatus:leeg wordt doorgegeven als een blanko
 New RCPNr,LEVNr
 Set (RCPNr,LEVNr)=""
 Set Optie=$G(Optie)
 Set ObjType=$G(ObjType)
 Set ObjRef=$G(ObjRef)
 Set WStat=$G(WStat)
 Set PStat=$G(PStat)
 If ObjType="L",ObjRef Set LEVNr=ObjRef Set:Optie'["L" Optie=Optie_"L"
 For  Do  Quit:Inp'=""&($L(Inp)<2)  Quit:RCPNr
 .Set Inp=$$ASKL^vhINP("EWRCP","SELECT")
 .If Inp=""!zb Set Inp=$$LIST(ObjType,ObjRef,WStat,PStat,LEVNr) Quit:'Inp
 .If Inp="L" Set Inp=$$SELECT^LEVER(1,"","Recepties van leverancier : ") Set:Inp LEVNr=Inp Set Inp="" Quit
 .If Inp="P" Set Inp=$$PROD(ObjType,ObjRef,WStat,PStat,LEVNr) If 'Inp Set Inp="" Quit
 .If Inp="Z" Set (LEVNr,Inp)="" Quit
 .Quit:Optie["N"&(Inp="N")  ; optie : Nieuw 
 .If Inp'?.N,$L(Inp)<2,Inp'="N" Quit  ; Stoptekens -,.()
 .If '$D(^RCP("D",Inp)) Set Inp="" Quit
 .If $$CHKSTAT(Inp,ObjType,ObjRef,WStat,PStat),$$CHKLEV(Inp,LEVNr) Set RCPNr=Inp
 Quit $S(RCPNr:RCPNr,1:Inp)
 ;
CHKSTAT(RCPNr,ObjType,ObjRef,WStat,PStat) 
 New RStat,Rec
 Set Rec=^RCP("D",RCPNr)
 Quit:Rec="" 0
 If $L(WStat) Set RStat=$P(Rec,D,20) Set:RStat="" RStat=" " Quit:WStat'[RStat 0
 If $L(PStat) Set RStat=$P(Rec,D,21) Set:RStat="" RStat=" " Quit:PStat'[RStat 0
 If $L(ObjType),$P(Rec,D,1)'=ObjType Quit 0 
 If $L(ObjRef),$P(Rec,D,2)'=ObjRef Quit 0
 Quit 1
 ;
CHKLEV(RCPNr,LEVNr) 
 New Ok
 Set Ok=1 Set:LEVNr Ok=$D(^RCP("IL",LEVNr,RCPNr))
 Quit Ok
 ;
LIST(ObjType,ObjRef,WStat,PStat,LEVNr,PRNr) 
 New %J,RCPNr,zb,ViaLev,ViaProd,Count,LD
 Set (LEVNr,ViaLev)=$G(LEVNr),(PRNr,ViaProd)=$G(PRNr)
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Do OPENST(%J,ObjType,ObjRef,WStat,PStat,LEVNr,PRNr)
 Do INIT^vhLIST("EWRCP","SELECT",.LD)
 Do
 .Set R=$P(LD("POS"),"`")
 .Set Count=+$O(^HULP(%J,""),-1)
 .Quit:Count>($P(R,";",3)-$P(R,";"))
 .Set Count=$$CBMORE(Count,$P(R,";",3)-$P(R,";")+1,$G(^HULP(%J,Count)))
 .Quit:Count>($P(R,";",3)-$P(R,";"))
 .Set FP=$P(R,";")*100+1
 .Write @F,@F1
 .Set $P(R,";")=$P(R,";",3)-$O(^HULP(%J,""),-1)+1 Set:$P(R,";")>24 $P(R,";")=24
 .Set $P(LD("POS"),"`")=R,$P(LD("SET"),"`")=R
 .Set $P(R,";",2,9)=$P($P(LD("POS"),"`",2),";",2,9),$P(LD("POS"),"`",2)=R
 Do WRITE^vhLIST(.LD)
 For  Set R=$$SCROLL^vhLIST(.LD) Do  Quit:R="ENTER"!(R="-")
 Set RCPNr=$S(R="ENTER":$P($G(^HULP(%J,LD("SELECT"))),D),1:"")
 Kill ^HULP(%J)
 Quit RCPNr
 ;
PROD(ObjType,ObjRef,WStat,PStat,LEVNr) 
 New RCPNr,PRNr
 Set PRNr=$$SELECT^PRODUKT6($S(LEVNr:"L",1:""),LEVNr,,,"NODO;NOKP")
 Set RCPNr=$S(PRNr:$$LIST(ObjType,ObjRef,WStat,PStat,LEVNr,PRNr),1:"")
 Quit RCPNr
 ;
OPENST(%J,ObjType,ObjRef,WStat,PStat,LEVNr,PRNr) 
 New R,RCPNr,Count,TOENr,TLUNr,BONNr,BLUNr
 Set Count=0
 If PRNr Do
 .Set TOENr=""
 .For  Set TOENr=$O(^TO("IP",PRNr,TOENr)) Quit:TOENr=""  Do
 ..Quit:'$D(^RCP("IT",TOENr))
 ..Set TLUNr=""
 ..For  Set TLUNr=$O(^RCP("IT",TOENr,TLUNr)) Quit:TLUNr=""  Do
 ...Set RCPNr=^RCP("IT",TOENr,TLUNr)
 ...Quit:$D(RCPNr(RCPNr))  Quit:'$D(^RCP("IO",RCPNr))
 ...Set R=^RCP("D",RCPNr,"D",TOENr,TLUNr)
 ...Quit:$P(R,D)'=PRNr
 ...Quit:'$$CHKSTAT(RCPNr,ObjType,ObjRef,WStat,PStat) 
 ...Set R=RCPNr,$P(R,D,11)=^RCP("D",RCPNr)
 ...Set Count=Count+1,^HULP(%J,Count)=R
 ...Set RCPNr(RCPNr)=""
 .Quit:LEVNr
 .Set BONNr=""
 .For  Set BONNr=$O(^RCP("IU",BONNr)) Quit:BONNr=""  Do
 ..Set RCPNr=^RCP("IU",BONNr)
 ..Quit:$D(RCPNr(RCPNr))  Quit:'$D(^RCP("IO",RCPNr))
 ..Set BLUNr=""
 ..For  Set BLUNr=$O(^RCP("D",RCPNr,"D",BONNr,BLUNr)) Quit:BLUNr=""  Do
 ...Set R=^RCP("D",RCPNr,"D",BONNr,BLUNr)
 ...Quit:$P(R,D)'=PRNr
 ...Quit:'$$CHKSTAT(RCPNr,ObjType,ObjRef,WStat,PStat) 
 ...Set R=RCPNr,$P(R,D,11)=^RCP("D",RCPNr)
 ...Set Count=Count+1,^HULP(%J,Count)=R
 ...Set RCPNr(RCPNr)=""
 Else  Do
 .Set RCPNr=""
 .For  Set RCPNr=$O(^RCP("IO",RCPNr)) Quit:'RCPNr  Do
 ..Set R=RCPNr,$P(R,D,11)=^RCP("D",RCPNr)
 ..If LEVNr Quit:$P(R,D,11)'="L"  Quit:$P(R,D,12)'=LEVNr
 ..Quit:'$$CHKSTAT(RCPNr,ObjType,ObjRef,WStat,PStat) 
 ..Set Count=Count+1,^HULP(%J,Count)=R
 Quit
 ;
CBMORE(Max,Len,Rec) ; Om de niet openstaande recepties in stukjes op te halen
 New R,RCPNr,TOENr,TLUNr,SepLine
 Set RCPNr=$P(Rec,D),SepLine=0
 If RCPNr,$D(^RCP("IO",RCPNr)) Set RCPNr="",SepLine=1
 If ViaProd Do
 .Set TOENr=""
 .For  Set TOENr=$O(^TO("IP",PRNr,TOENr)) Quit:TOENr=""  Do
 ..Quit:'$D(^RCP("IT",TOENr))
 ..Set TLUNr=""
 ..For  Set TLUNr=$O(^RCP("IT",TOENr,TLUNr)) Quit:TLUNr=""  Do
 ...Set RCPNr=^RCP("IT",TOENr,TLUNr)
 ...Quit:$D(RCPNr(RCPNr))  Quit:$D(^RCP("IO",RCPNr))
 ...Set R=^RCP("D",RCPNr,"D",TOENr,TLUNr)
 ...Quit:$P(R,D)'=PRNr
 ...Quit:'$$CHKSTAT(RCPNr,ObjType,ObjRef,WStat,PStat) 
 ...Set R=RCPNr,$P(R,D,11)=^RCP("D",RCPNr)
 ...Set Max=Max+1,^HULP(%J,Max)=R
 ...Set RCPNr(RCPNr)=""
 Else  Do
 Set Len=Len+Max
 For  Set RCPNr=$O(^RCP("D",RCPNr)) Quit:RCPNr=""  Do  Quit:Max'<Len
 .Quit:$D(^RCP("IO",RCPNr))
 .Set R=RCPNr,$P(R,D,11)=^RCP("D",RCPNr)
 .If ViaLev Quit:$P(R,D,11)'="L"  Quit:$P(R,D,12)'=ViaLev
 .Quit:'$$CHKSTAT(RCPNr,ObjType,ObjRef,WStat,PStat) 
 .If SepLine Set Max=Max+1,^HULP(%J,Max)="&S",SepLine=0
 .Set Max=Max+1,^HULP(%J,Max)=R
 Set:RCPNr="" Max=-Max ; Alles gehad
 Quit Max
 ;