PVORDS2 ;E'WMS Opbouw van een Consolidatie order [ 11/08/2003   8:27 PM ]
 ;
BLDCONS(KLNr,MarkRef,CONSNr,VerzW,VerzDat,DOutTime,VerzZ,LevAdr) 
 ; Het order is gelockt door het oproepende programma
 ; @MarkRef bevat voor de verschillende Orders en OLUNrs het aantal (piece 1) voor het WMS en of er een BackOrder moet gekreeerd worden (piece 2).
 ; Het BackOrder mag een markering B dan is BOQty=OLQty-MarkedQty, of het mag het Backorder aantal zelf zijn.
 New ORDNr,OLNr,OLUNr,OLCnt,AutoCons,CredCnt,OLRec,Qty,BOQty,Sort,ManOpsl,BOLwk
 Lock +^ORDW("D",CONSNr)
 ; Consolidatie hoofding
 Set:'VerzDat VerzDat=+$H
 Set CONSRec=""
 Set $P(CONSRec,D,1)=KLNr
 Set $P(CONSRec,D,2)=VerzW
 Set $P(CONSRec,D,3)=DOutTime
 Set $P(CONSRec,D,4)=VerzZ
 Set $P(CONSRec,D,5)=VerzDat
 ;Set $P(CONSRec,D,20)="W"
 Set $P(CONSRec,D,22)=$H
 Set ^ORDW("D",CONSNr)=CONSRec
 Set:$L($TR($G(LevAdr),D,"")) ^ORDW("D",CONSNr,"A")=LevAdr
 ;
 Set (ORDNr,OLUNr)=""
 Set (OLCnt,AutoCons,CredCnt)=0
 For  Set ORDNr=$O(@MarkRef@("A",ORDNr)) Quit:ORDNr=""  Do
 .Lock +^KOD(KLNr,"F",ORDNr)
 .For  Set OLUNr=$O(@MarkRef@("A",ORDNr,OLUNr)) Quit:OLUNr=""  Do
 ..Set OLNr=^ORD("IU",ORDNr,OLUNr)
 ..Set OLRec=^KOD(KLNr,"F",ORDNr,OLNr)
 ..Set Qty=$P($G(@MarkRef@("A",ORDNr,OLUNr)),D)
 ..Quit:'Qty
 ..Set BOQty=$P(@MarkRef@("A",ORDNr,OLUNr),D,2)
 ..Set BOQty=$S(BOQty="B":$P(OLRec,D,3)-Qty,BOQty>0:BOQty,1:"")
 ..Set:$P(OLRec,D,3)>0&(BOQty<1) BOQty="" ; Picking
 ..Set:$P(OLRec,D,3)<0&(BOQty>-1) BOQty="" ; Terugname
 ..Set BOLwk=$P(@MarkRef@("A",ORDNr,OLUNr),D,4)
 ..Set OLCnt=OLCnt+1,ManOpsl=$$OPSLMAN^PRODUKT2($P(OLRec,D,2))
 ..If Qty<0!($P(OLRec,D,14)["Z")!ManOpsl Do  ; Terugname, ZONDER picking, opslag manueel of werkvloer
 ...Do BLDAOL(KLNr,CONSNr,ORDNr,OLUNr,Qty)
 ...Set AutoCons=AutoCons+1 Set:Qty<0 CredCnt=CredCnt+1
 ..Else  Do  ; Doorgeven aan WMS
 ...Do BLDOL(KLNr,CONSNr,ORDNr,OLUNr,Qty,BOQty,BOLwk)
 .Lock -^KOD(KLNr,"F",ORDNr)
 Set $P(^ORDW("D",CONSNr),D,6)=$S(CredCnt=OLCnt:"C",CredCnt:"G",1:"F")
 Set:OLCnt ^ORDW("IK",KLNr,CONSNr)=""
 If AutoCons Do  ; Indien gemarkeerde lijnen zijn terugnames, ZONDER picking of opslag manueel
 .If '$$CHECK^EWORDS3(CONSNr,1) Do BELET^EWORDS3(CONSNr,"B") Quit
 .Do UITLEV(CONSNr,AutoCons=OLCnt)
 Else  Do CHKCONS(CONSNr)
 Lock -^ORDW("D",CONSNr)
 Quit
 
 New ORDNr,OLNr,OLUNr,OLCnt,AutoCons,CredCnt,OLRec,Qty,BOQty,Sort,ManOpsl,BOLwk
BLDAOL(KLNr,CONSNr,ORDNr,OLUNr,Qty) 
 ; Terugnames, zonder WMS en manueel krijgen onmiddellijk status afgewerkt.
 New OLNr,OLRec,PRNr,KPRNr
 Set OLNr=^ORD("IU",ORDNr,OLUNr)
 Set OLRec=^KOD(KLNr,"F",ORDNr,OLNr)
 Set PRNr=$P(OLRec,D,2)
 Set OLRec=""
 Set $P(OLRec,D,1)=PRNr
 Set $P(OLRec,D,2)="A" ; Status : Afgewerkt
 Set $P(OLRec,D,4)=Qty
 Set ^ORDW("D",CONSNr,"D",ORDNr,OLUNr)=OLRec
 Set ^ORDW("IO",ORDNr,OLUNr)=CONSNr
 ;
 If $D(^PRLINK("D",PRNr)) Do  ; Opslitsen in kindproducten
 .Set KPRNr=""
 .For  Set KPRNr=$O(^PRLINK("D",PRNr,KPRNr)) Quit:KPRNr=""  Do
 ..Do BLDASUB(CONSNr,ORDNr,OLUNr,KPRNr,Qty*$P(^PRLINK("D",PRNr,KPRNr),D))
 Else  Do
 .Do BLDASUB(CONSNr,ORDNr,OLUNr,PRNr,Qty)
 Quit
 
BLDASUB(CONSNr,ORDNr,OLUNr,PRNr,Qty) 
 ; opbouw van een suborderlijn onmiddellijk status afgewerkt.
 New SubRec,SubOLNr,C,PRRec,Txt
 Set SubOLNr=$O(^ORDW("D",CONSNr,"D",ORDNr,OLUNr,""),-1)
 Set SubOLNr=SubOLNr\100+1*100
 Set SubRec=""
 Set $P(SubRec,D,1)=PRNr
 Set $P(SubRec,D,2)="A" ; Status = Afgewerkt
 Set $P(SubRec,D,3)=Qty
 Set:$$OPSLZONE^PRODUKT2(PRNr)=9 $P(SubRec,D,4)=Qty ; Werkvloerprodukt
 Set ^ORDW("D",CONSNr,"D",ORDNr,OLUNr,SubOLNr)=SubRec
 Quit
 
BLDOL(KLNr,CONSNr,ORDNr,OLUNr,Qty,BOQty,BOLwk) 
 ; Verwerken van een orderlijn met eventuele opslitsing in verschillende kindproducten
 New OLNr,OLRec,PRNr,KPRNr,ManOpsl,ManChk
 Set OLNr=^ORD("IU",ORDNr,OLUNr) ; Misschien veranderd door BACKORD, daarom terug ophalen
 Set OLRec=^KOD(KLNr,"F",ORDNr,OLNr)
 Set PRNr=$P(OLRec,D,2)
 If 'PRNr Do ERROR^EWLOG("NOPROD") Quit
 ;Opbouw OL in ORDW
 Set OLRec=""
 Set $P(OLRec,D,1)=PRNr
 Set $P(OLRec,D,4)=Qty
 Set $P(OLRec,D,6)=BOQty
 Set $P(OLRec,D,7)=$$INTDATE^vhDTyp(BOLwk,"DW")
 Set ^ORDW("D",CONSNr,"D",ORDNr,OLUNr)=OLRec
 Set ^ORDW("IO",ORDNr,OLUNr)=CONSNr
 ;
 If $D(^PRLINK("D",PRNr)) Do  ; Opslitsen in kindproducten
 .Set KPRNr=""
 .Set ManChk=1
 .For  Set KPRNr=$O(^PRLINK("D",PRNr,KPRNr)) Quit:KPRNr=""  Do
 ..Set ManOpsl=$$OPSLMAN^PRODUKT2(KPRNr)
 ..Set:'ManOpsl ManChk=0
 ..Do:ManOpsl BLDASUB(CONSNr,ORDNr,OLUNr,KPRNr,Qty*$P(^PRLINK("D",PRNr,KPRNr),D))
 ..Do:'ManOpsl BLDSUB(CONSNr,ORDNr,OLUNr,KPRNr,Qty*$P(^PRLINK("D",PRNr,KPRNr),D))
 .If ManChk Do
 ..Set OLRec=^ORDW("D",CONSNr,"D",ORDNr,OLUNr)
 ..Set $P(OLRec,D,2)="A"
 ..Set $P(OLRec,D,5)=$P(OLRec,D,4)
 ..Set AutoCons=AutoCons+1 ; onthouden dat er een automatische lijn is
 ..Set ^ORDW("D",CONSNr,"D",ORDNr,OLUNr)=OLRec
 .Do ADDRES^PRODUKT4(PRNr,Qty) ; Moederproduct reservatie !
 Else  Do
 .Do BLDSUB(CONSNr,ORDNr,OLUNr,PRNr,Qty)
 Quit
 
BLDSUB(CONSNr,ORDNr,OLUNr,PRNr,Qty) 
 ; opbouw van een suborderlijn
 New SubRec,SubOLNr,C,PRRec,Txt
 Set SubOLNr=$O(^ORDW("D",CONSNr,"D",ORDNr,OLUNr,""),-1)
 Set SubOLNr=SubOLNr\100+1*100
 Set SubRec=""
 Set $P(SubRec,D,1)=PRNr
 Set $P(SubRec,D,3)=Qty
 Set ^ORDW("D",CONSNr,"D",ORDNr,OLUNr,SubOLNr)=SubRec
 Do ADDRES^PRODUKT4(PRNr,Qty)
 Quit
 
UITLEV(CONSNr,All,NoAsk) 
 If All Do 
 .Set $P(^ORDW("D",CONSNr),D,20)="C"
 .Do BON^EWBON(CONSNr,$G(NoAsk)) ; Op bon zetten manueel door de gebruiker
 Else  Do
 .Set $P(^ORDW("D",CONSNr),D,20)="" ; Niet volledig dus partieel afgewerkt
 Quit
 
CHKCONS(CONSNr) 
 New CONSRec,OLRec,SubRec,ORDNr,OLUNr,SubOLNr,OLUStat,SubStat
 Set (ORDNr,OLUStat)=""
 For  Set ORDNr=$O(^ORDW("D",CONSNr,"D",ORDNr)) Quit:ORDNr=""  Do  Quit:OLUStat'="A"  ; Stop bij de eerstevolgende niet afgewerkte order(lijn)
 . Set OLUNr=""
 . For  Set OLUNr=$O(^ORDW("D",CONSNr,"D",ORDNr,OLUNr)) Quit:OLUNr=""  Do  Quit:OLUStat'="A" ; Stop bij de eerstvolgende niet afgewerkte orderlijn
 .. Set (SubOLNr,SubStat)=""
 .. For  Set SubOLNr=$O(^ORDW("D",CONSNr,"D",ORDNr,OLUNr,SubOLNr)) Quit:SubOLNr=""  Do  Quit:SubStat'="A"  ; Stop bij de eerstvolgende niet afgewerkte sublijn
 ... Set SubStat=$P(^ORDW("D",CONSNr,"D",ORDNr,OLUNr,SubOLNr),D,2)
 .. If SubStat="A" Do
 ... Write "Overbrenging",CONSNr,$C(9),ORDNr,$C(9),OLUNr,$C(9)
 ... Set $P(^ORDW("D",CONSNr,"D",ORDNr,OLUNr),D,2)="A" ; Overerving, alle sublijnen zijn Afgewerkt
 .. Set OLUStat=$P(^ORDW("D",CONSNr,"D",ORDNr,OLUNr),D,2)
 
 ;If OLUStat="A" Do  ; Alle orderlijnen zijn afgewerkt, niet naar WMS onmiddellijk op bon
 . If '$$CHECK^EWORDS3(CONSNr,1) Do BELET^EWORDS3(CONSNr,"B") Quit
 . Do UITLEV(CONSNr,1)
 Quit
 
 ; Errormeldingen 
NOPROD ;"Geen product gedefinieerd in :"_ORDNr_";"_OLUNr
NOSEND ;"Order kan niet worden doorgestuurd omwille van status :"_ORDNr_";"_$P(^ORD(KLNr,"F",ORDNr,1),D,30)