flowbon6 ;Selecteren van een leveringsbon en het afdrukken van de Orgaluxlabels [ 11/25/2003  3:03 PM ]
 
 Set K="AFDRUKKEN ORGALUXETIKETTEN "_QN_" ",FP=203+$L(K)
 Write @F61,@F11,@F1,@F,@F5
 Set FP=202
 Write @F,@F4,K,@F5
 Do INIT^vhPRINTER("","","UB")
 Set Dev=$G(Print("DEV"))
 Do:$L(Dev)
 .New C,KLNr,BONNr
 .For  Set BONNr=$$SELECT^FLOW("KUL","KU1",1) Quit:BONNr="-"  Do PRINT(BONNr)
 Quit
 
FETCHBON(C) 
 New R,KLNr,Adr,BONNr
 Set BONNr=C("BONNR"),KLNr=$P(^KU1(BONNr,"F"),D)
 Set Adr=$G(^KUL(KLNr,"F",BONNr,3))
 Set:$L($TR(Adr,"\",""))<5 Adr=^KKL(^KK1(KLNr),0)
 Set C("BONNR")=$$EXTNUM^vhDTyp(BONNr,0,".",0)
 Set C("KLNM")=$P(Adr,D,2)
 Set C("GEMEENTE")=$E($P(Adr,D,7),1,18)
 Set C("TAAL")=$P(^KKL(^KK1(KLNr),0),D,9)
 Set C("FETCHBON")=1,C("BONNR")=BONNr
 Quit
 
FETCHORD(C) 
 New R,KLNr,OrdRef,OrgalRef,BONNr,ORDNr,BLNr
 Set BONNr=C("BONNR"),BLNr=C("BLNR"),KLNr=$P(^KU1(BONNr,"F"),D)
 Kill C("FETCHORD"),C("ORDNR")
 For  Set BLNr=$O(^KUL(KLNr,"F",BONNr,BLNr),-1) Quit:BLNr<100  Do  Quit:$G(C("ORDNR"))
 .Set R=^KUL(KLNr,"F",BONNr,BLNr)
 .Quit:$P(R,D,17)'="KF5"
 .Set ORDNr=$P($P(R,D,5)," - "),OrdRef=$P($P(R,D,5)," - ",3),OrgalRef=$P(R,D,20)
 .Set C("ORDREF")=OrdRef
 .Set C("ORGLREF")=OrgalRef
 .Set C("FETCHORD")=1,C("ORDNR")=ORDNr
 Quit
 
FETCHPR(C) 
 New I,R,PRNr,KortTxt,LangTxt1,LangTxt2,LangTxt3,OrgVerp
 Set PRNr=C("PRNR")
 Do ORGVERP(PRNr,.OrgVerp)
 Kill C("ORGVERP")
 Set OrgVerp=""
 For  Set OrgVerp=$O(OrgVerp(OrgVerp)) Quit:OrgVerp=""  Do
 .Set C("ORGVERP",OrgVerp)=OrgVerp(OrgVerp)
 .Merge:OrgVerp="I" C("ORGVERP",OrgVerp)=OrgVerp(OrgVerp)
 Do:$D(C("GROEP"))
 .If C("GROEP") Do
 ..Kill C("ORGVERP")
 ..Set C("ORGVERP","S")=1
 .Else  Do
 ..Kill C("ORGVERP","S"),C("ORGVERP","Z")
 ..If '$D(C("ORGVERP","I")),'$D(C("ORGVERP","O")) Set C("ORGVERP","Z")=""
 Do:PRNr
 .Set R=^KPR(PRNr,0),C("KORTTXT")=$E($P(R,D),4,11)
 .Set R=$$GETOMSCH^PRODUKT2(PRNr,$G(C("TAAL"),"N"))
 .For I=1:1 Quit:$P(R,D,I)=""  Set C("LANGTXT"_I)=$P(R,D,I)
 .For I=I:1 Quit:'$D(C("LANGTXT"_I))  Kill C("LANGTXT"_I)
 Quit
 
WLABEL(Dev,C) 
 Do TLABEL(Dev,.C) Quit
 New I
 ;If $G(io)=1027 Use 0 Goto wlabel
 ;If $G(CUserId)=3 Use 0 Goto wlabel
 For I=1:1 Set Lijn=$T(@("L"_$G(C("TAAL"),"N")_$S($G(C("PRNR"))="V":"V",1:"")_I)) Quit:Lijn=""  Do
 .Write @$P(Lijn,";",2),!
 Quit
 
wlabel 
 New r
 For I=1:1 Set Lijn=$T(@("L"_$G(C("TAAL"),"N")_$S($G(C("PRNR"))="V":"V",1:"")_I)) Quit:Lijn=""  Do
 .Write @$P(Lijn,";",2),!
 Read r
 Quit
 
TLABEL(Dev,C) 
 New I,R,Rec
 ;If $G(io)=1027 Use 0 Goto tlabel
 ;If $G(CUserId)=3 Use 0 Goto tlabel
 Set Rec=""
 For I=1:1 Set Lijn=$T(@("L"_$G(C("TAAL"),"N")_"T"_$S($G(C("PRNR"))="V":"V",1:"")_I)) Quit:Lijn=""  Do
 .Xecute "Set R="_$P(Lijn,";",2)
 .Set Rec=Rec_$C(9)_R
 .;Set Rec=Rec_";"_R
 Set $E(Rec)=""
 Write Rec,!
 Quit
 
tlabel 
 New r
 For I=1:1 Set Lijn=$T(@("L"_$G(C("TAAL"),"N")_"T"_$S($G(C("PRNR"))="V":"V",1:"")_I)) Quit:Lijn=""  Do
 .Xecute "Set R="_$P(Lijn,";",2)
 .Set Rec=Rec_$C(9)_R
 .;Set Rec=Rec_";"_R
 Write Rec,!
 Read r
 Quit
 
 ; BONNr kan meerdere nrs bevatten "\" gescheiden.
 ; Elk BONNr kan als volgt zijn opgebouwd:
 ;   BONNr = de volledige bon
 ;   BONNr#ULNr = Bepaalde lijn van een bon
 ;   BONNr#ULNr#Aantal = Bepaald aantal (verschillend van het aantal in de lijn)
 ;   BONNr#?#Aantal#PRNr = Bepaald aantal van bepaald produkt (lijn onbekend)
PRINT(BONNr,BackGrnd) 
 New I,C,R
 Set BackGrnd=$G(BackGrnd)
 If 'BackGrnd Do STORE^vhTERMINA() Set FP=2001 Write @F,@F1,!?2,"Printing ..."
 Open Dev
 Use Dev
 ;If $G(io)=1027 Close Dev
 ;If $G(CUserId)=3 Close Dev
 If $L($G(BONNr)) For I=1:1:$L(BONNr,D) Do
 .Set R=$P(BONNr,D,I)
 .If $P(R,"#") Do
 ..If $L($P(R,"#",2)) Set BONNr($P(R,"#"),$P(R,"#",2))=$P(R,"#",3,4)
 ..Else  Set BONNr($P(R,"#"))=""
 Set BONNr=""
 For  Set BONNr=$O(BONNr(BONNr)) Quit:BONNr=""  Do
 .Kill C
 .Merge C("BONNR")=BONNr
 .Do ONEBON(.C,1)
 Close:$L(Dev) Dev
 Do:'BackGrnd REFRESH^vhTERMINA()
 Quit
 
ONEBON(C,BackGrnd) 
 New R,KLNr,BONNr,BLNr,PRNr,Aantal
 Set BackGrnd=$G(BackGrnd)
 Merge BONNr=C("BONNR")
 Kill C("BONNR")
 Set R=$G(^KU1(BONNr,"F"))
 If $L(R),'$P(R,D,2) Do
 .Set KLNr=$P(R,D),C("BONNR")=BONNr
 .Do:'$G(C("FETCHBON")) FETCHBON(.C)
 .If $O(BONNr(BONNr,""))="" Do  ; De volledige bon
 ..Set BLNr=100
 ..For  Set BLNr=$O(^KUL(KLNr,"F",BONNr,BLNr)) Quit:'BLNr  Do
 ...Set R=^KUL(KLNr,"F",BONNr,BLNr),PRNr=$P(R,D,2)
 ...If $P(R,D,17)="KF5" Set C("BLNR")=BLNr+1 Do FETCHORD(.C)
 ...Kill C("AANTAL"),C("PRNR"),C("ORGVERP")
 ...Set C("BLNR")=BLNr
 ...Do:PRNr ONELINE(.C,1)
 .Else  Do  ; Enkele lijnen van bon BONNr
 ..Set BLNr=""
 ..For  Set BLNr=$O(BONNr(BONNr,BLNr)) Quit:BLNr=""  Do
 ...Set R=BONNr(BONNr,BLNr),Aantal=$P(R,D),PRNr=$P(R,D,2)
 ...Kill C("FETCHORD"),C("ORDNR"),C("AANTAL"),C("PRNR"),C("ORGVERP")
 ...Set C("BLNR")=$P(BONNr(BONNr,BLNr),D,3)
 ...Set:PRNr C("PRNR")=PRNr Set:$L(Aantal) C("AANTAL")=Aantal,C("GROEP")=Aantal[";"
 ...Do ONELINE(.C,1)
 Do:'BackGrnd REFRESH^vhTERMINA()
 Quit
 
ONELINE(C,BackGrnd) 
 New R,KLNr,BONNr,BLNr,PRNr,Aantal
 Set BackGrnd=$G(BackGrnd),BONNr=C("BONNR"),BLNr=C("BLNR")
 Set R=$G(^KU1(BONNr,"F"))
 If $L(R),'$P(R,D,2) Do
 .Set KLNr=$P(R,D)
 .Set R=$G(^KUL(KLNr,"F",BONNr,BLNr)),PRNr=$P(R,D,2),Aantal=$P(R,D,3)
 .Set:'$D(C("PRNR")) C("PRNR")=PRNr Set:'$D(C("AANTAL")) C("AANTAL")=Aantal
 .Do:'$G(C("FETCHBON")) FETCHBON(.C)
 .If '$G(C("FETCHORD")) Set C("BLNR")=$S(BLNr="?":999,1:BLNr+1) Do FETCHORD(.C)
 .Set C("BLNR")=BLNr,PRNr=C("PRNR")
 .If BLNr="?",PRNr="" Set (PRNr,C("PRNR"))="V"
 .If PRNr,$$ISORGAL^PRODUKT2(PRNr) Do ONETIKET(.C,1)
 .If PRNr="V" Do ONETIKET(.C,1)
 Do:'BackGrnd REFRESH^vhTERMINA()
 Quit
 
ONETIKET(C,BackGrnd) 
 New R,OrgVerp,Aantal,ExtAant,PRNr
 Set BackGrnd=$G(BackGrnd),BONNr=C("BONNR"),BLNr=C("BLNR"),PRNr=C("PRNR")
 Do FETCHPR(.C)
 Set Aantal=C("AANTAL")
 For  Do  Quit:Aantal=""
 .Do:Aantal>0
 ..Kill OrgVerp
 ..Merge OrgVerp=C("ORGVERP")
 ..Set OrgVerp=""
 ..For  Set OrgVerp=$O(OrgVerp(OrgVerp)) Quit:OrgVerp=""  Do
 ...Quit:OrgVerp="E"
 ...Kill C("OVVP"),C("COUNT"),C("MAXCOUNT")
 ...Set C("AANTAL")=$P(Aantal,";")
 ...Set:OrgVerp="S" C("COUNT")=$J("x"_$P(Aantal,";"),5),C("AANTAL")=1
 ...Set:OrgVerp="O" C("OVVP")=OrgVerp
 ...Do:OrgVerp="I"
 ....Set C("MAXCOUNT")=OrgVerp("I")+$G(OrgVerp("Z"))
 ....Set C("COUNT")=C("MAXCOUNT")+1
 ....Kill OrgVerp("I"),OrgVerp("Z")
 ...For I=1:1:$S($G(C("MAXCOUNT")):C("MAXCOUNT"),1:C("AANTAL")) Do
 ....Set ExtAant=0
 ....If $G(C("MAXCOUNT")) Do
 .....Set:I=C("MAXCOUNT") ExtAant=$G(C("ORGVERP","E"))
 .....If $TR(C("COUNT")," ","")>C("MAXCOUNT") Set C("COUNT")=$J("1/"_C("MAXCOUNT"),5)
 .....Else  Set C("COUNT")=$J($TR(C("COUNT")," ","")+1_"/"_C("MAXCOUNT"),5)
 .....Set:'ExtAant ExtAant=$G(C("ORGVERP","I",+$TR(C("COUNT")," ","")))
 .....For J=1:1:C("AANTAL")+ExtAant Do WLABEL(Dev,.C)
 ....Else  Do
 .....Set ExtAant=$G(C("ORGVERP","E"))
 .....For J=1:1:1+ExtAant Do WLABEL(Dev,.C)
 .Set Aantal=$P(Aantal,";",2,99)
 Do:'BackGrnd REFRESH^vhTERMINA()
 Quit
 
 ; BONNr doorgegeven als .Local
 ; BONNr(BONNr1)=""
 ; BONNr(BONNr2,BLNr1)=""
 ; BONNr(BONNr2,BLNr2)=Aantal
 ; BONNr(BONNr2,"?")=Aantal_D_PRNr
EXTERN(BONNr,Dev,BackGrnd) 
extern
 New C
 ;Set:'$L($G(Dev)) Dev=$$DEV^vhPRINTER("lbl ORGALUX") ; Device labelprinter : \\VERZENDING\LABEL ORGALUX
 ;Set:'$L($G(Dev)) Dev=$$OPEN^vhDEV(,"ORGALUX.LBL","WA")
 Set:'$L($G(Dev)) Dev=$$OPEN^vhDEV(,"ORGALUX.LBL","W")
 Do PRINT(.BONNr,$G(BackGrnd))
 Quit
 
 ; I = Individueel
 ; S = Single
 ; O = Verpakking
ORGVERP(MPRNr,OrgVerp) 
 New R,BSCode,KPRNr,ICount
 Set (OrgVerp,BSCode)="",ICount=0
 For  Set BSCode=$O(^PRBS("BS",MPRNr,BSCode)) Quit:BSCode=""  Do
 .Set R=^PRBS("BS",MPRNr,BSCode),KPRNr=$P(R,D)
 .Quit:'KPRNr
 .Set:$P(R,D,12)="" $P(R,D,12)="Z"
 .Set ICount=ICount+1
 .If $E($P(R,D,12))="I" Do
 ..Set OrgVerp("I")=$G(OrgVerp("I"),1)+$P(R,D,2)
 ..Set:$E($P(R,D,12),2,9)>1 OrgVerp("I",ICount)=$E($P(R,D,12),2,9)-1
 .Else  If $E($P(R,D,12))="E" Do
 ..If $E($P(R,D,12),2)="-"
 ..Else  Set OrgVerp("E")=$G(OrgVerp("E"))+($E($P(R,D,12),2)*$P(R,D,2))
 .Else  Set OrgVerp($P(R,D,12))=1
 Quit
 
 ; Label definitie NEDERLANDS (transfert)
LNT1 ;$G(C("KORTTXT"))
LNT2 ;$G(C("COUNT"))
LNT3 ;$G(C("LANGTXT1"))
LNT4 ;$G(C("LANGTXT2"))
LNT5 ;$G(C("LANGTXT3"))
LNT6 ;"Ref:"
LNT7 ;$G(C("ORGLREF"))
LNT8 ;$G(C("KLNM"))_$S($L($G(C("KLNM")))&$L($G(C("GEMEENTE"))):" - ",1:"")_$G(C("GEMEENTE"))
LNT9 ;$G(C("BONNR"))
LNT10 ;$G(C("ORDREF"))
 ; Label definitie NEDERLANDS Verpakking (transfert)
LNTV1 ;"N"
LNTV2 ;""
LNTV3 ;""
LNTV4 ;""
LNTV5 ;""
LNTV6 ;""
LNTV7 ;$G(C("ORGLREF"))
LNTV8 ;$G(C("KLNM"))_$S($L($G(C("KLNM")))&$L($G(C("GEMEENTE"))):" - ",1:"")_$G(C("GEMEENTE"))
LNTV9 ;$G(C("BONNR"))
LNTV10 ;$G(C("ORDREF"))
 ; Label definitie FRANS (transfert)
LFT1 ;$G(C("KORTTXT"))
LFT2 ;$G(C("COUNT"))
LFT3 ;$G(C("LANGTXT1"))
LFT4 ;$G(C("LANGTXT2"))
LFT5 ;$G(C("LANGTXT3"))
LFT6 ;"Ref:"
LFT7 ;$G(C("ORGLREF"))
LFT8 ;$G(C("KLNM"))_$S($L($G(C("KLNM")))&$L($G(C("GEMEENTE"))):" - ",1:"")_$G(C("GEMEENTE"))
LFT9 ;$G(C("BONNR"))
LFT10 ;$G(C("ORDREF"))
 ; Label definitie FRANS Verpakking (transfert)
LFTV1 ;"F"
LFTV2 ;""
LFTV3 ;""
LFTV4 ;""
LFTV5 ;""
LFTV6 ;""
LFTV7 ;$G(C("ORGLREF"))
LFTV8 ;$G(C("KLNM"))_$S($L($G(C("KLNM")))&$L($G(C("GEMEENTE"))):" - ",1:"")_$G(C("GEMEENTE"))
LFTV9 ;$G(C("BONNR"))
LFTV10 ;$G(C("ORDREF"))
 ; Label definitie DUITS (transfert)
LDT1 ;$G(C("KORTTXT"))
LDT2 ;$G(C("COUNT"))
LDT3 ;$G(C("LANGTXT1"))
LDT4 ;$G(C("LANGTXT2"))
LDT5 ;$G(C("LANGTXT3"))
LDT6 ;"Ref:"
LDT7 ;$G(C("ORGLREF"))
LDT8 ;$G(C("KLNM"))_$S($L($G(C("KLNM")))&$L($G(C("GEMEENTE"))):" - ",1:"")_$G(C("GEMEENTE"))
LDT9 ;$G(C("BONNR"))
LDT10 ;$G(C("ORDREF"))
 ; Label definitie DUITS Verpakking (transfert)
LDTV1 ;"D"
LDTV2 ;""
LDTV3 ;""
LDTV4 ;""
LDTV5 ;""
LDTV6 ;""
LDTV7 ;$G(C("ORGLREF"))
LDTV8 ;$G(C("KLNM"))_$S($L($G(C("KLNM")))&$L($G(C("GEMEENTE"))):" - ",1:"")_$G(C("GEMEENTE"))
LDTV9 ;$G(C("BONNR"))
LDTV10 ;$G(C("ORDREF"))