FLOWBON3 ;Bon [ 05/21/2003  11:54 AM ]
 #include BL.Derde.KlantSpecifiek
 
 ; CheckOpTransp default op 1
DELLINE(BONNr,OLNr,Extern,ProfNr,CheckOpTransp) 
 New %TC,R,KLNr,PRNr,PR,Date,Munt,Pariteit,Aantal,Netto,Kom,ProfOLNr,StockUpd,IsEuro,BLUNr,OrdDat,ORDNr
 Set Extern=$G(Extern),ProfNr=$G(ProfNr),CheckOpTransp=$G(CheckOpTransp,1)
 Set KLNr=$P(^KU1(BONNr,"F"),D)
 Do
 .Set R=^KUL(KLNr,"F",BONNr,OLNr),(PRNr,PR)=$P(R,D,2),BLUNr=$P(R,D,15)
 .If $P(R,D,17)="KF5" Set ORDNr=$P($P(R,D,5)," - ") Do:ORDNr
 ..If $P($G(^KO1(ORDNr,"F")),D)=KLNr,'$D(^KOD(KLNr,"F",ORDNr)) Kill ^KO1(ORDNr,"F")
 ..Do DelOrd^KLACHT4(ORDNr)
 .If PRNr,'$$ISOVP^ORGALUX(PRNr),CheckOpTransp,$$OPTRANSP^FLOWBON(KLNr,BONNr,OLNr,1) Quit
 .Set StockUpd=$P(R,D,14)'["S" Set:StockUpd StockUpd=$P(R,D,14)'["Z"
 .For  Do ADD^vhLock("^KUL(KLNr,""F"",BONNr,OLNr)") Quit:%TC  Do LDISP^vhLock("^KUL(KLNr,""F"",BONNr,OLNr)","Bon "_BONNr)
 .If PRNr,'StockUpd
 .Else  If PRNr,$$OPSLMAN^PRODUKT2(PRNr)!$$ISOVP^ORGALUX(PRNr) Do
 ..Set Aantal=-$P(R,D,3),Netto=-$P(R,D,10),VerwTyp=$P(R,D,14),Kom=$P($P(R,D,28),";")="KOM"
 ..Set R=^KUL(KLNr,"F",BONNr,1),Date=$P(R,D,2),Munt=$P(R,D,18) Set:Munt="" Munt=$$FADEF^vhRtn1()
 ..Set Date=$$CONVDATE^vhDTyp(Date,"DK","DSN")
 ..Set Pariteit=$$MUNT^vhRtn1(Munt,,12),Netto=Netto*Pariteit
 ..If Aantal'>0 Do
 ...Set IsEuro=$$ISEURO^vhRtn1()
 ...For  Do ADD^vhLock("^KPR(PRNr)") Quit:%TC  Do LDISP^vhLock("^KPR(PRNr)","Produkt "_$P(^KPR(PRNr,0),D))
 ...Set R=Date_2_D_$S(VerwTyp["S":0,VerwTyp["Z":0,1:Aantal)_D_D_1_D
 ...Set R=R_$J($S(VerwTyp["S":0,VerwTyp["Z":0,1:Netto),0,$S(IsEuro:4,1:2))_"\0\0\"_BONNr_" STORNO ("_KLNr_")"
 ...Do ^KPR10
 ...Set OrdDat=$P($$ORDGEG^FLOWBON(KLNr,BONNr,OLNr),D,2) Set:$L(OrdDat) OrdDat=$$INTDATE^vhDTyp(OrdDat)
 ...Do PUT^PRHIST(PRNr,$S(VerwTyp["S":0,VerwTyp["Z":0,1:-Aantal),"I",,KLNr,BONNr,BLUNr,$$INTDATE^vhDTyp(Date),,,,,,OrdDat)
 ...Do REMOVE^vhLock("^KPR(PRNr)")
 ..Set R=PRNr_D_Date_D_Aantal_D_$J(Netto,1,2)_D_Kom Do ^KPUW
 .Else  If PRNr,ProfNr,'$$ISOVP^ORGALUX(PRNr) Do
 ..Set ProfOLNr=^KUL(KLNr,"F",ProfNr,0),^KUL(KLNr,"F",ProfNr,0)=ProfOLNr+1
 ..Set ($P(R,D,15),$P(R,D,23))="",^KUL(KLNr,"F",ProfNr,ProfOLNr)=R
 ..Do BUILDBON(KLNr,ProfNr,ProfOLNr),BUILDKUP(KLNr,ProfNr,ProfOLNr)
 ..Set $P(R,D,3)=-$P(R,D,3) For I=9,10,16 Set $P(R,D,I)=$J(-$P(R,D,I),0,2)
 ..Set $P(R,D,15)="",ProfOLNr=^KUL(KLNr,"F",ProfNr,0),^KUL(KLNr,"F",ProfNr,0)=ProfOLNr+1
 ..Set ^KUL(KLNr,"F",ProfNr,ProfOLNr)=R
 ..Do BUILDBON(KLNr,ProfNr,ProfOLNr),BUILDKUP(KLNr,ProfNr,ProfOLNr)
 .Do DELBON(KLNr,BONNr,OLNr),DELKUP(KLNr,BONNr,OLNr)
 .If BLUNr,PRNr Do
 ..Do:$$CHKCUST(KLNr) ST2CC(KLNr,BONNr,OLNr)
 ..Kill ^PRHISTI("B",BONNr,BLUNr),AkpVkpVerlies(BLUNr)
 .Kill ^KUL(KLNr,"F",BONNr,OLNr)
 .If '$O(^KUL(KLNr,"F",BONNr,100)) Do
 ..Set R=^KUL(KLNr,"F",BONNr,1) Do KILL^KFVZW("F",R,BONNr)
 ..If Extern Kill ^KU1(BONNr,"F"),^KUB(BONNr,"F"),^KU2("F",KLNr,BONNr),^KUL(KLNr,"F",BONNr)
 ..Do DelBon^KLACHT4(BONNr),DelVRIJGAVE^FLOW2(KLNr,"B",BONNr)
 .Do REMOVE^vhLock("^KUL(KLNr,""F"",BONNr,OLNr)")
 Quit
 ;
 ; CheckOpTransp default op 1
DELOBJ(BONNr,CheckOpTransp) 
 New %TC,KLNr,OLNr,OpTransp
 Set CheckOpTransp=$G(CheckOpTransp,1)
 Set KLNr=$P(^KU1(BONNr,"F"),D),OpTransp=$S(CheckOpTransp:$$OPTRANSP^FLOWBON(KLNr,BONNr,,1),1:0)
 Do:'OpTransp
 .Set OLNr=100
 .For  Do ADD^vhLock("^KUL(KLNr,""F"",BONNr)") Quit:%TC  Do LDISP^vhLock("^KUL(KLNr,""F"",BONNr)","Bon "_BONNr)
 .For  Set OLNr=$O(^KUL(KLNr,"F",BONNr,OLNr)) Quit:'OLNr  Do DELLINE(BONNr,OLNr)
 .Kill ^KU1(BONNr,"F"),^KUB(BONNr,"F"),^KU2("F",KLNr,BONNr),^KUL(KLNr,"F",BONNr)
 .Do DelBon^KLACHT4(BONNr),DelVRIJGAVE^FLOW2(KLNr,"B",BONNr)
 .Do REMOVE^vhLock("^KUL(KLNr,""F"",BONNr)")
 Quit
 ;
CHKDEL(BONNr) 
 New R,KLNr,OLNr,LineTyp
 Set KLNr=$P($G(^KU1(BONNr,"F")),D)
 Do:KLNr
 .Set OLNr=100
 .For  Set OLNr=$O(^KUL(KLNr,"F",BONNr,OLNr)) Quit:'OLNr  Do  Quit:"\KF11\KF5\"'[(D_LineTyp_D)
 ..Set R=^KUL(KLNr,"F",BONNr,OLNr),LineTyp=$P($P(R,D,17),"#")
 .Do:'OLNr DELOBJ(BONNr)
 Quit
 ;
BUILDBON(KLNr,BONNr,BLNr) 
 Set KLNr=$G(KLNr,0),BONNr=$G(BONNr),BLNr=$G(BLNr)
 Do BUILDIU(KLNr,BONNr,BLNr) 
 Do BUILDIP(KLNr,BONNr,BLNr) 
 Quit
 ;
BUILDIU(KLNr,BONNr,BLNr) 
 New R,OneCust,OneBon,OneLine,PRNr,BLUNr
 Set KLNr=$G(KLNr,0),BONNr=$G(BONNr),BLNr=$G(BLNr)
 Set (OneCust,OneBon,OneLine)=0
 Set:KLNr OneCust=1 Set:BONNr OneBon=1 Set:BLNr OneLine=1
 For  Set:'OneCust KLNr=$O(^KUL(KLNr)) Quit:KLNr=""  Do  Quit:OneCust
 .Set:'OneBon BONNr=0
 .For  Set:'OneBon BONNr=$O(^KUL(KLNr,"F",BONNr)) Quit:BONNr=""  Do  Quit:OneBon
 ..Set:'OneLine BLNr=100
 ..For  Set:'OneLine BLNr=$O(^KUL(KLNr,"F",BONNr,BLNr)) Quit:'BLNr  Do  Quit:OneLine
 ...Set R=^KUL(KLNr,"F",BONNr,BLNr),PRNr=$P(R,D,2),BLUNr=$P(R,D,15)
 ...If 'BLUNr Set BLUNr=$$UNIEKLNR^FLOWBON(KLNr,BONNr),$P(R,D,15)=BLUNr,^KUL(KLNr,"F",BONNr,BLNr)=R
 ...Quit:'PRNr
 ...Set ^BON("IU",BONNr,BLUNr)=BLNr
 Quit
 ;
BUILDIP(KLNr,BONNr,BLNr) 
 New R,OneCust,OneBon,OneLine,BLUNr,PRNr
 Set KLNr=$G(KLNr,0),BONNr=$G(BONNr),BLNr=$G(BLNr)
 Set (OneCust,OneBon,OneLine)=0
 Set:KLNr OneCust=1 Set:BONNr OneBon=1 Set:BLNr OneLine=1
 For  Set:'OneCust KLNr=$O(^KUL(KLNr)) Quit:KLNr=""  Do  Quit:OneCust
 .Set:'OneBon BONNr=0
 .For  Set:'OneBon BONNr=$O(^KUL(KLNr,"F",BONNr)) Quit:BONNr=""  Do  Quit:OneBon
 ..Set:'OneLine BLNr=100
 ..For  Set:'OneLine BLNr=$O(^KUL(KLNr,"F",BONNr,BLNr)) Quit:'BLNr  Do  Quit:OneLine
 ...Set R=^KUL(KLNr,"F",BONNr,BLNr),PRNr=$P(R,D,2),BLUNr=$P(R,D,15)
 ...If 'BLUNr Set BLUNr=$$UNIEKLNR^FLOWBON(KLNr,BONNr),$P(R,D,15)=BLUNr,^KUL(KLNr,"F",BONNr,BLNr)=R
 ...Quit:'PRNr
 ...Set ^BON("IP",PRNr,BONNr,BLUNr)=BLNr
 Quit
 ;
DELBON(KLNr,BONNr,BLNr) 
 Set KLNr=$G(KLNr,0),BONNr=$G(BONNr),BLNr=$G(BLNr)
 Do DELIU(KLNr,BONNr,BLNr) 
 Do DELIP(KLNr,BONNr,BLNr) 
 Quit
 ;
DELIU(KLNr,BONNr,BLNr) 
 New R,OneCust,OneBon,OneLine,BLUNr
 Set KLNr=$G(KLNr,0),BONNr=$G(BONNr),BLNr=$G(BLNr)
 Set (OneCust,OneBon,OneLine)=0
 Set:KLNr OneCust=1 Set:BONNr OneBon=1 Set:BLNr OneLine=1
 For  Set:'OneCust KLNr=$O(^KUL(KLNr)) Quit:KLNr=""  Do  Quit:OneCust
 .Set:'OneBon BONNr=0
 .For  Set:'OneBon BONNr=$O(^KUL(KLNr,"F",BONNr)) Quit:BONNr=""  Do  Quit:OneBon
 ..Set:'OneLine BLNr=100
 ..For  Set:'OneLine BLNr=$O(^KUL(KLNr,"F",BONNr,BLNr)) Quit:'BLNr  Do  Quit:OneLine
 ...Set R=^KUL(KLNr,"F",BONNr,BLNr),PRNr=$P(R,D,2),BLUNr=$P(R,D,15)
 ...If 'BLUNr Set BLUNr=$$UNIEKLNR^FLOWBON(KLNr,BONNr),$P(R,D,15)=BLUNr,^KUL(KLNr,"F",BONNr,BLNr)=R
 ...Quit:'PRNr
 ...Kill ^BON("IU",BONNr,BLUNr)
 Quit
 ;
DELIP(KLNr,BONNr,BLNr) 
 New R,OneCust,OneBon,OneLine,BLUNr,PRNr
 Set KLNr=$G(KLNr,0),BONNr=$G(BONNr),BLNr=$G(BLNr)
 Set (OneCust,OneBon,OneLine)=0
 Set:KLNr OneCust=1 Set:BONNr OneBon=1 Set:BLNr OneLine=1
 For  Set:'OneCust KLNr=$O(^KUL(KLNr)) Quit:KLNr=""  Do  Quit:OneCust
 .Set:'OneBon BONNr=0
 .For  Set:'OneBon BONNr=$O(^KUL(KLNr,"F",BONNr)) Quit:BONNr=""  Do  Quit:OneBon
 ..Set:'OneLine BLNr=100
 ..For  Set:'OneLine BLNr=$O(^KUL(KLNr,"F",BONNr,BLNr)) Quit:'BLNr  Do  Quit:OneLine
 ...Set R=^KUL(KLNr,"F",BONNr,BLNr),PRNr=$P(R,D,2),BLUNr=$P(R,D,15)
 ...If 'BLUNr Set BLUNr=$$UNIEKLNR^FLOWBON(KLNr,BONNr),$P(R,D,15)=BLUNr,^KUL(KLNr,"F",BONNr,BLNr)=R
 ...Quit:'PRNr
 ...Kill ^BON("IP",PRNr,BONNr,BLUNr)
 Quit
 ;
CHECKBON 
 Do
 .New Check,File
 .Set Q="K"
 .Do ^cA604
 If '$D(Check) Write !!,"*** WMS bon ***"
 Set KLNr=0
 For  Set KLNr=$O(^KUL(KLNr)) Quit:'KLNr  Do
 .Set BONNr=""
 .For  Set BONNr=$O(^KUL(KLNr,"F",BONNr)) Quit:'BONNr  Do
 ..Set BLNr=100
 ..If '$D(^KUL(KLNr,"F",BONNr,4)) Do
 ...If $D(Check) Set Check=0
 ...Else  Write !!,$ZR," onbekend"
 ..For  Set BLNr=$O(^KUL(KLNr,"F",BONNr,BLNr)) Quit:'BLNr  Do
 ...Set R=^KUL(KLNr,"F",BONNr,BLNr),ZR=$ZR,PRNr=$P(R,D,2),ULUNr=$P(R,D,15)
 ...If 'ULUNr Do  Quit
 ....If $D(Check) Set Check=0
 ....Else  Write !!,ZR,!,R,!,"ULUNr onbekend"
 ...Quit:'PRNr
 ...If '$D(^BON("IU",BONNr,ULUNr)) Do
 ....If $D(Check) Set Check=0
 ....Else  Write !!,ZR,!,R,!,$ZR," onbekend"
 ...If $D(^BON("IU",BONNr,ULUNr)),^BON("IU",BONNr,ULUNr)'=BLNr Do
 ....If $D(Check) Set Check=0
 ....Else  Write !!,ZR,!,R,!,^BON("IU",BONNr,ULUNr),!,$ZR," Verschillend"
 ...If '$D(^BON("IP",PRNr,BONNr,ULUNr)) Do
 ....If $D(Check) Set Check=0
 ....Else  Write !!,ZR,!,R,!,$ZR," onbekend"
 ...If $D(^BON("IP",PRNr,BONNr,ULUNr)),^BON("IP",PRNr,BONNr,ULUNr)'=BLNr Do
 ....If $D(Check) Set Check=0
 ....Else  Write !!,ZR,!,R,!,^BON("IP",PRNr,BONNr,ULUNr),!,$ZR," Verschillend"
 Set BONNr=""
 For  Set BONNr=$O(^BON("IU",BONNr)) Quit:'BONNr  Do
 .Set ULUNr=""
 .For  Set ULUNr=$O(^BON("IU",BONNr,ULUNr)) Quit:'ULUNr  Do
 ..Set R=^BON("IU",BONNr,ULUNr),ZR=$ZR,BLNr=$P(R,D)
 ..Set KLNr=$P($G(^KU1(BONNr,"F")),D)
 ..If 'KLNr Do  Quit
 ...If $D(Check) Set Check=0
 ...Else  Write !!,ZR,!,"Bon onbekend" ;Kill ^BON("IU",BONNr,ULUNr)
 ..If '$D(^KUL(KLNr,"F",BONNr)) Do  Quit
 ...If $D(Check) Set Check=0
 ...Else  Write !!,ZR,!,"Bon onbekend"
 ..Set R=$G(^KUL(KLNr,"F",BONNr,BLNr))
 ..If R="" Do  Quit
 ...If $D(Check) Set Check=0
 ...Else  Write !!,ZR,!,"Bonlijn onbekend"
 ..If $P(R,D,15)'=ULUNr Do
 ...If $D(Check) Set Check=0
 ...Else  Write !!,ZR,!,"ULUNr verschillend"
 Set PRNr=""
 For  Set PRNr=$O(^BON("IP",PRNr)) Quit:'PRNr  Do
 .Set BONNr=""
 .For  Set BONNr=$O(^BON("IP",PRNr,BONNr)) Quit:'BONNr  Do
 ..Set ULUNr=""
 ..For  Set ULUNr=$O(^BON("IP",PRNr,BONNr,ULUNr)) Quit:'ULUNr  Do
 ...Set R=^BON("IP",PRNr,BONNr,ULUNr),ZR=$ZR,BLNr=$P(R,D)
 ...Set KLNr=$P($G(^KU1(BONNr,"F")),D)
 ...If 'KLNr Do  Quit
 ....If $D(Check) Set Check=0
 ....Else  Write !!,ZR,!,"Bon onbekend"
 ...If '$D(^KUL(KLNr,"F",BONNr)) Do  Quit
 ....If $D(Check) Set Check=0
 ....Else  Write !!,ZR,!,"Bon onbekend"
 ...Set R=$G(^KUL(KLNr,"F",BONNr,BLNr))
 ...If R="" Do  Quit
 ....If $D(Check) Set Check=0
 ....Else  Write !!,ZR,!,"Bonlijn onbekend"
 ...If $P(R,D,2)'=PRNr Do
 ....If $D(Check) Set Check=0
 ....Else  Write !!,ZR,!,"PRNr verschillend"
 ...If $P(R,D,15)'=ULUNr Do
 ....If $D(Check) Set Check=0
 ....Else  Write !!,ZR,!,"ULUNr verschillend"
 Quit
 ;
CHECK(File) 
 New (File)
 Set File=$G(File,"BP"),Check=1
 Do:File["B" CHECKBON
 Do:File["P" CHECKKUP
 Quit Check
 ;
BUILDKUP(KLNr,BONNr,BLNr) 
 New R,OneCust,OneBon,OneLine,PRNr
 Set KLNr=$G(KLNr,0),BONNr=$G(BONNr),BLNr=$G(BLNr)
 Set (OneCust,OneBon,OneLine)=0
 Set:KLNr OneCust=1 Set:BONNr OneBon=1 Set:BLNr OneLine=1
 For  Set:'OneCust KLNr=$O(^KUL(KLNr)) Quit:KLNr=""  Do  Quit:OneCust
 .Set:'OneBon BONNr=0
 .For  Set:'OneBon BONNr=$O(^KUL(KLNr,"F",BONNr)) Quit:BONNr=""  Do  Quit:OneBon
 ..Set:'OneLine BLNr=100
 ..For  Set:'OneLine BLNr=$O(^KUL(KLNr,"F",BONNr,BLNr)) Quit:'BLNr  Do  Quit:OneLine
 ...Set R=^KUL(KLNr,"F",BONNr,BLNr),PRNr=$P(R,D,2)
 ...Quit:'PRNr
 ...Set ^KUP(PRNr,BONNr,BLNr)=KLNr
 Quit
 ;
DELKUP(KLNr,BONNr,BLNr) 
 New R,OneCust,OneBon,OneLine,PRNr
 Set KLNr=$G(KLNr,0),BONNr=$G(BONNr),BLNr=$G(BLNr)
 Set (OneCust,OneBon,OneLine)=0
 Set:KLNr OneCust=1 Set:BONNr OneBon=1 Set:BLNr OneLine=1
 For  Set:'OneCust KLNr=$O(^KUL(KLNr)) Quit:KLNr=""  Do  Quit:OneCust
 .Set:'OneBon BONNr=0
 .For  Set:'OneBon BONNr=$O(^KUL(KLNr,"F",BONNr)) Quit:BONNr=""  Do  Quit:OneBon
 ..Set:'OneLine BLNr=100
 ..For  Set:'OneLine BLNr=$O(^KUL(KLNr,"F",BONNr,BLNr)) Quit:'BLNr  Do  Quit:OneLine
 ...Set R=^KUL(KLNr,"F",BONNr,BLNr),PRNr=$P(R,D,2)
 ...Quit:'PRNr
 ...Kill ^KUP(PRNr,BONNr,BLNr)
 Quit
 ;
CHECKKUP 
 Do
 .New Check,File
 .Set Q="K"
 .Do ^cA604
 If '$D(Check) Write !!,"*** ^KUP ***"
 Set KLNr=0
 For  Set KLNr=$O(^KUL(KLNr)) Quit:'KLNr  Do
 .Set BONNr=""
 .For  Set BONNr=$O(^KUL(KLNr,"F",BONNr)) Quit:'BONNr  Do
 ..Set BLNr=100
 ..For  Set BLNr=$O(^KUL(KLNr,"F",BONNr,BLNr)) Quit:'BLNr  Do
 ...Set R=^KUL(KLNr,"F",BONNr,BLNr),ZR=$ZR,PRNr=$P(R,D,2)
 ...Quit:'PRNr
 ...If '$D(^KUP(PRNr,BONNr,BLNr)) Do
 ....If $D(Check) Set Check=0
 ....Else  Write !!,ZR,!,R,!,$ZR," onbekend"
 ...If $D(^KUP(PRNr,BONNr,BLNr)),^KUP(PRNr,BONNr,BLNr)'=KLNr Do
 ....If $D(Check) Set Check=0
 ....Else  Write !!,ZR,!,R,!,^KUP(PRNr,BONNr,BLNr),!,$ZR," Verschillend"
 Set PRNr=""
 For  Set PRNr=$O(^KUP(PRNr)) Quit:'PRNr  Do
 .Set BONNr=""
 .For  Set BONNr=$O(^KUP(PRNr,BONNr)) Quit:'BONNr  Do
 ..Set BLNr=""
 ..For  Set BLNr=$O(^KUP(PRNr,BONNr,BLNr)) Quit:'BLNr  Do
 ...Set R=^KUP(PRNr,BONNr,BLNr),ZR=$ZR
 ...Set KLNr=$P($G(^KU1(BONNr,"F")),D)
 ...If 'KLNr Do  Quit
 ....If $D(Check) Set Check=0
 ....Else  Write !!,ZR,!,"Bon onbekend"
 ...If '$D(^KUL(KLNr,"F",BONNr)) Do  Quit
 ....If $D(Check) Set Check=0
 ....Else  Write !!,ZR,!,"Bon onbekend"
 ...Set R=$G(^KUL(KLNr,"F",BONNr,BLNr))
 ...If R="" Do  Quit
 ....If $D(Check) Set Check=0
 ....Else  Write !!,ZR,!,"Bonlijn onbekend"
 ...If $P(R,D,2)'=PRNr Do
 ....If $D(Check) Set Check=0
 ....Else  Write !!,ZR,!,"PRNr verschillend"
 Quit
 ;
EXTERN(BONNr) 
 New Locals,UR
 Set (Locals("ULNr"),UR)=BONNr,Locals("Extern")=1
 Do DO^vhPROGRAM("FUE^KF9","","",$G(NoMod))
 Quit
 ;
ST2CC(KLNr,BONNr,BLNr)
 New R,PRNr,BLUNr,HistNr,HistRec,SubRec,MagPallet
 Set R=^KUL(KLNr,"F",BONNr,BLNr),PRNr=$P(R,D,2),BLUNr=$P(R,D,15)
 If $$CHKCUST(KLNr),PRNr,BLUNr,$D(^PRHISTI("B",BONNr,BLUNr,PRNr)) Do
 . Set PRNr=""
 . For  Set PRNr=$O(^PRHISTI("B",BONNr,BLUNr,PRNr)) Quit:PRNr=""  Do
 . . Set HistNr=^PRHISTI("B",BONNr,BLUNr,PRNr),HistRec=$G(^PRHIST(PRNr,HistNr))
 . . If "#U#R#"[("#"_$P(HistRec,D,4)_"#"),$P(HistRec,D,6)=KLNr,$P(HistRec,D,7)=BONNr,$P(HistRec,D,8)=BLUNr Do
 . . . Quit:$P(HistRec,D,10)  ; Factuurnummer is ingevuld
 . . . Set SubRec=$G(^PRHIST(PRNr,HistNr,1)),MagPallet=$P(SubRec,D)
 . . . Set $P(HistRec,D,4)="X",$P(HistRec,D,6,8)="\\",$P(HistRec,D,11)="C/C"_$S($L(MagPallet):" "_MagPallet,1:"")
 . . . Set ^PRHIST(PRNr,HistNr)=HistRec
 Quit
 ;
BON2CC(KLNr,BONNr)
 New BonRec,PRNr
 Set:'$G(KLNr) KLNr=$P(^KU1(BONNr,"F"),D)
 Set BLNr=100
 If $$CHKCUST(KLNr) For  Set BLNr=$O(^KUL(KLNr,"F",BONNr,BLNr)) Quit:'BLNr  Do
 . Set R=^KUL(KLNr,"F",BONNr,BLNr),PRNr=$P(R,D,2)
 . Do:PRNr ST2CC(KLNr,BONNr,BLNr)
 ;
CHKCUST(KLNr)
 Quit (KLNr=$$$KlantBVanHoecke)||(KLNr=$$$KlantAtlasHolding)
 ;
 ; Lijnnummer via uniek lijnnummer
BLNR(BONNr,BLUNr)
 Quit ^BON("IU",BONNr,BLUNr)
 ;