BLPRGEG ; BLUM produktgegevens ;BLPRGEG; [ 09/24/2002  12:36 PM ]
 G BEGIN
 ;
T1 ;*** I'm thinking ***
T2 ;SET;OMSCHRIJVING;BESCHRIJVING;VERSCHILLEN;STAFFELING;BLUM KLANTEN
T3 ;WELK SCHERM ;V,B,O,S,T,K   -[] = einde programma
T4 ; T | Beschrijving
T5 ;1;C;R;2;; | \2;C;L;40
T6 ; Omschrijving
T7 ;1;C;L;80
T8 ; Identnummer | Korttekst                 | Aantal
T9 ;0;C;R;1;;\1;C;L;11;; | \3;C;L;25;; |\2;N;R;8
T10 ; Omschrijving       | BLUM gegevens             | VH gegevens
T11 ;0;C;R;1;;\1;C;L;18;; | \2;C;L;25;; | \3;C;L;25
T20 ;BLUM PRODUKT INFO;OVERZICHT
T21 ; Geen verschillen voor dit produkt 
T22 ; Produkt onbekend bij VH 
T23 ;Neen;Ja
 ;
T101 ;IDENTNUMMER;4;2;;4;19;;$S($D(^KPR2(8_$E(K,2,99)_" ")):8,1:0)_"."_$E(K,2,4)_"."_$E(K,5,7)_"."_$E(K,8,99);11;;;;;;;201
T102 ;KORTTEKST;5;2;;5;19;;K D BLD;25;;;;;;;101
T103 ;BESTAAT VH;6;2;;6;19;;$P("Niet\Kom\Stock",D,K+1);1;;;;4;;;220
T104 ;STOCKTYPE;3;47;;3;65;;K_$S($L($$Leverdagen2WeekID^BLPROD(ID)):" ("_$$Leverdagen2WeekID^BLPROD(ID)_"w)",1:"");1;;;;14;;;102
T105 ;SETTYPE;4;47;;4;65;;;1;;;;;;;103
T106 ;PROGRAMMATIE;5;47;;5;65;;K D BLD;1;;;;10;;;108
T107 ;KLAS VD3;6;47;;6;65;;K s U3="" S:$L(K) U3=##class(Blum.Klassificatie).OpenV3(K) S:$isObject($G(U3)) U3=$E(U3.Omschrijving,1,16) D BLD;16;;;;;;;119
T108 ;KLAS VD2;7;47;;7;65;;K s U3="" S:$L(K) U3=##class(Blum.Klassificatie).OpenV2(K) S:$isObject($G(U3)) U3=$E(U3.Omschrijving,1,16) D BLD;16;;;;;;;119
T109 ;E12;8;2;;8;19;;K W @F,@FMTU,"   E12    ",@FMTu;0;;;;;;;"";;;;;;;1
T110 ;E24;8;2;;8;35;;K W @F,@FMTU,"   E24    ",@FMTu;0;;;;;;;"";;;;;;;1
T111 ;PRIJS;9;2;;9;19;;K S K=$P($G(^BLProd("D",BLID,"PPL",212250)),D) S DC=2 D JUN,BLD S U3=$S(K:U3_$S($P($G(^BLProd("D",BLID,"PPL",212250)),D,3)="H":"%",$P($G(^BLProd("D",BLID,"PPL",212250)),D,3)="M":"/M",1:""),1:"");8;;;;6;;;""
T112 ;PRIJS;9;2;;9;35;;K S K=$P($G(^BLProd("D",BLID,"PPL",271250)),D) S DC=2 D JUN,BLD I K S U3=$S(K:U3_$S($P($G(^BLProd("D",BLID,"PPL",271250)),D,3)="H":"%",$P($G(^BLProd("D",BLID,"PPL",271250)),D,3)="M":"/M",1:""),1:"");8;;;;6;;;"";;;;;;;1
T113 ;MIN BST H;10;2;;10;19;;K S K=$P($G(^BLProd("D",BLID,"PPL",212250)),D,6) S DC=0 D JUN,BLD;8;;;;;;;"";;;;;;;
T114 ;MIN BST H;10;2;;10;35;;K S K=$P($G(^BLProd("D",BLID,"PPL",271250)),D,6) S DC=0 D JUN,BLD;8;;;;;;;115;;;;;;;1
T115 ;GELDIG VAN;11;2;;11;19;;$$EXTDATE^vhDTyp($P($G(^BLProd("D",BLID,"PPL",212250)),D,5)) D BLD;13;;;;;;;""
T116 ;GELDIG VAN;11;2;;11;35;;$$EXTDATE^vhDTyp($P($G(^BLProd("D",BLID,"PPL",271250)),D,5)) D BLD;13;;;;;;;"";;;;;;;1
T117 ;RABAT-KODE;12;2;;12;19;;$$ROG^BLPRGEG($P($G(^BLProd("D",BLID,"PPL",212250)),D,4),1,212250) D BLD;13;;;;;;;""
T118 ;RABAT-KODE;12;2;;12;35;;$$ROG^BLPRGEG($P($G(^BLProd("D",BLID,"PPL",271250)),D,4),1,271250) D BLD;13;;;;;;;"";;;;;;;1
T119 ;SPEC. PRIJS;14;2;;14;19;;K S DC=2 D JUN S:K U3=U3_" EUR"_$S($P(B(3),D,2)="H":"/%",$P(B(3),D,2)="M":"/M",1:"");8;;;;6;;;301
T120 ;SPEC. KORT.;15;2;;15;19;;K S K=K*100,DC=2 D JUN S:K U3=U3_" %";8;;;;6;;;303
T121 ;VERPAKKING 1;8;47;;8;65;;K S DC=0 D JUN,BLD;5;;;;;;;104
T122 ;VERPAKKING 2;9;47;;9;65;;K S DC=0 D JUN,BLD;5;;;;;;;105
T123 ;VERPAKKING 3;10;47;;10;65;;K S DC=0 D JUN,BLD;5;;;;;;;106
T124 ;# EUROPALET;11;47;;11;65;;K S DC=0 D JUN,BLD;10;;;;;;;118
T125 ;BRUT/1000;12;47;;12;65;;K S DC=2 D JUN,BLD;10;;;;;;;109
T126 ;NET/1000;13;47;;13;65;;K S DC=2 D JUN,BLD;10;;;;;;;126
T127 ;LAATSTE UPD;15;47;;15;65;;;8;;;;;;;117
T128 ;Afm (LxBxH);14;47;;14;65;;K_"x"_$P(B(1),D,24)_"x"_$P(B(1),D,25) S:$TR(U3,"x0","")="" U3="";15;;;;;;;123;
 ;
T201 ;Korttekst;$P(B(1),D,1);$P(A(1),D,1);;;101;0.1.C
T202 ;Prijs A;$S('BPrijs:$P(PRIJS,D,1),1:+$P(A("J"),D,19));+$P(A("J"),D,19);;S DC=2,U1=2 D FMT S U1=3 D FMT;110;J.19.N;2.3.N
T203 ;Prijs B;$S(BPrijs:$P(PRIJS,D,1),1:+$P(A("J"),D,19));+$P(A("J"),D,19);;S DC=2,U1=2 D FMT S U1=3 D FMT;111;J.19.N;2.3.N
T204 ;Levertermijn;K;+$P(A("J"),D,7);S K=$P(B(1),D,8),K=$S(K="V":1,K="L":1,K="N":6,K="S":8,K="E":8,1:0);;108;J.7.N
T205 ;Min bestelhoeveelheid A;$S('BPrijs:$P(PRIJS,D,7),1:+$P(A("J"),D,6));+$P(A("J"),D,6);;S DC=0,U1=2 D FMT S U1=3 D FMT;114;J.6.N
T206 ;Min bestelhoeveelheid B;$S(BPrijs:$P(PRIJS,D,7),1:+$P(A("J"),D,6));+$P(A("J"),D,6);;S DC=0,U1=2 D FMT S U1=3 D FMT;114;J.6.N
T207 ;Grootverpakking;K;+$P(A("J"),D,16);S K=$S('GVP&($P(B(1),D,3)="M"):+$P(A("J"),D,16),1:GVP);S DC=0,U1=2 D FMT S U1=3 D FMT;106;J.16.N
T208 ;Normverpakking;NVP;+$P(A("J"),D,15);;S DC=0,U1=2 D FMT S U1=3 D FMT;105;J.15.NB
T209 ;Kleinverpakking;KVP;+$P(A("J"),D,14);;S DC=0,U1=2 D FMT S U1=3 D FMT;104;J.14.NB
T210 ;Gewicht;+$P(B(1),D,9);+$P(A(2),D,13);;S DC=2,U1=2 D FMT S U1=3 D FMT;109;1.13.N
T211 ;Korting;$P(PRIJS,D,3)*100;+$P(A("J"),D,9);;S DC=2,U1=2 D FMT S U1=3 D FMT;116;J.9.N;2.4.NB
T212 ;Klassifikatie;BKlas;VKlas;S (BKlas,VKlas)="" I $P(A("I"),D,4),$P($$CHKKLAS^BLPROD(PR),D,3)=0 S VKlas=$$DISPL^KLASS($P(A("I"),D,4)),oKlas=##class(Blum.Klassificatie).OpenV2($P(B(1),D,19)) If $isObject(oKlas) s BKlas=oKlas.SubGroepDisplay();;119
 ;
T401 ;KORTTEKST;;;;;;;;25;;;;;;;101
T402 ;STOCKTYPE;;;;;;;K_$S($L($$ICCode2LeverweekID^BLPROD(ID)):" ("_$$ICCode2LeverweekID^BLPROD(ID)_"w)",1:"");1;;;;14;;;102
T403 ;SETTYPE;;;;;;;;1;;;;;;;103
T404 ;PROGRAMMATIE;;;;;;;;1;;;;10;;;108
T405 ;VERPAKKING 1;;;;;;;;5;;;;;;;104
T406 ;VERPAKKING 2;;;;;;;;5;;;;;;;105
T407 ;VERPAKKING 3;;;;;;;;5;;;;;;;106
T408 ;# EUROPALET;;;;;;;;10;;;;;;;118
T409 ;BRUT/1000;;;;;;;$S(K:$$EXTNUM^vhDTyp(K,0,".",2),1:K);10;;;;;;;109
T410 ;NET/1000;;;;;;;$S(K:$$EXTNUM^vhDTyp(K,0,".",2),1:K);10;;;;;;;126
T411 ;KLAS VD3;;;;;;;K s U3="" S:$L(K) U3=##class(Blum.Klassificatie).OpenV3(K) S:$isObject($G(U3)) U3=$E(U3.Omschrijving,1,16);16;;;;;;;119
T412 ;KLAS VD2;;;;;;;K s U3="" S:$L(K) U3=##class(Blum.Klassificatie).OpenV2(K) S:$isObject($G(U3)) U3=$E(U3.Omschrijving,1,16);16;;;;;;;119
T413 ;Afm (LxBxH);;;;;;;K_"x"_$P(B(1),D,24)_"x"_$P(B(1),D,25) S:$TR(U3,"x0","")="" U3="";15;;;;;;;123;
T414 ;A-PRIJS;;;;;;;;10;;;;;;;110
T415 ;B-PRIJS;;;;;;;;10;;;;;;;111
T416 ;MIN BST H -A;;;;;;;;8;;;;;;;114
T417 ;MIN BST H -B;;;;;;;;8;;;;;;;115
T418 ;PRIJSDIMENTIE;;;;;;;;10;;;;;;;112
T419 ;GELDIG VAN;;;;;;;$$CONVDATE^vhDTyp(K);10;;;;;;;113
T420 ;EAN-KODE;;;;;;;;16;;;;;;;120
 ;
T501 ;PRIJS E12;9;2;;9;19;;K S K=$P(B(1),D) S DC=2 D JUN^BLPRGEG S U3=$S(K:U3_$S($P(B(1),D,3)="H":"%",$P(B(1),D,3)="M":"/M",1:""),1:"");8;;;;6;;;PPL212250
T502 ;PRIJS E24;9;2;;9;35;;K S K=$P(B(1),D) S DC=2 D JUN^BLPRGEG S U3=$S(K:U3_$S($P(B(1),D,3)="H":"%",$P(B(1),D,3)="M":"/M",1:""),1:"");8;;;;6;;;PPL271250
 ;
S2 S FP=$P(U2,U,5)*100+$P(U2,U,6) G S2C:'SW5 I '$P(U2,U,23) S FP=FP-3 W @F,@F9,":"
S2A S FP=$P(U2,U,2)*100+$P(U2,U,3) W:$P(U2,U,22) @F,$J(U1#100,2) I '$P(U2,U,23) S FP=FP+2 W @F,@F6,$P(U2,U,1),@F9
S2B S FP=$P(U2,U,5)*100+$P(U2,U,6)
S2C S X=$P(U2,U,16) S:'$D(B(X\100)) B(X\100)="\\\\\\\\\\\\\\\\\\\\\\\\\" S (K,U3)=$P(B(X\100),D,X#100)
S2D I $L($P(U2,U,8)) X "S U3="_$P(U2,U,8)
S2Z W:'SW5 @F,$J("",$P(U2,U,9)),$J("",$P(U2,U,13)) W @F,U3 Q
 ;
O1 S K=$P($T(T21),U,2) G OY
O2 S K=$P($T(T22),U,2) G OY
OY S FP=2403 W @F,@F1,@FMTI,K,@FMTi,@F0
OZ Q
 ;
 ;Schermaanduiding
SA S FP=255 W @F,@FMTB,$J($P($T(T2),U,$F("SOBVTK",U4)),25),@FMTb
 Q
 ;
SA1 S FP=255 W @F,$J("",5),@FMTK,$P($T(T1),U,2),@FMTk
 Q
 ;
 ; Initialisatie
IN S K=$P($T(+1),U,2)_QN_" ",FP=203+$L(K) W @F61,@F11,@F1,@F,@FMTi S FP=201 W @F,@FMTI,K,@FMTi
 S BES(2)=$P($T(T5),U,2,99),BES(3)=17,BES(8)=$P($T(T4),U,2,99)
 S SET(2)=$P($T(T9),U,2,99),SET(3)=17,SET(8)=$P($T(T8),U,2,99)
 S OPM(2)=$P($T(T7),U,2,99),OPM(3)=17,OPM(8)=$P($T(T6),U,2,99)
 S VER(2)=$P($T(T11),U,2,99),VER(3)=17,VER(8)=$P($T(T10),U,2,99)
 S SW5=1,R="P",(VTB,ID,IDX)=""
 Q
 ;
 ; Algemene gegevens
ALG S T=100
 Set B(3)=$G(^BLProd("RP",275250,BLID))
 Set:$D(^BLProd("RP",271250,BLID)) B(3)=^BLProd("RP",271250,BLID)
ALG1 S T=T+1 S U2=$P($T(@("T"_T)),U,2,99) I $L(U2) D S2 W @FMTb G ALG1
 S SW5=0
 Q
 ;
BLPRIJS(PRNr,DefBLKLNr)
 New BLKLNr,BLID,KLNr,IDNr
 Set BLKLNr=$G(DefBLKLNr)
 Set IDNr=$P(^KPR(PRNr,2),D,25)
 Set BLID=0_$TR($E(IDNr,2,99),".","")
 DO ;If $E(IDNr)>0,$E(IDNr)<8 Do  ; Speciaal kunde prijs
 . Set KLNr=$O(^PRPUTZ("N",PRNr,"")) 
 . Quit:'KLNr  ; Niet gepinned
 . Quit:$O(^PRPUTZ("N",PRNr,KLNr))'=""  ; Meer dan 1  
 . Set BLKLNr=$P(^PRPUTZ("N",PRNr,KLNr,0),D) ; Gepinned naar 1 en slechts 1 Blumklant
 Quit $$PRIJS(BLID,0,BLKLNr)
 
 ; Blum geeft vanaf 01/03/2010 extra korting voor sommige kundestammen - PV 25/02/2010
ExtraKorting(PRNr,DefBLKLNr)
 New BLKLNr,BLID,KLNr,IDNr
 Set BLKLNr=$G(DefBLKLNr)
 Set IDNr=$P(^KPR(PRNr,2),D,25)
 Set BLID=0_$TR($E(IDNr,2,99),".","")
 Do  ; Product gelinkt aan kundestamm
 . Set KLNr=$O(^PRPUTZ("N",PRNr,"")) 
 . Quit:'KLNr  ; Niet gepinned
 . Quit:$O(^PRPUTZ("N",PRNr,KLNr))'=""  ; Meer dan 1  
 . Set BLKLNr=$P(^PRPUTZ("N",PRNr,KLNr,0),D) ; Gepinned naar 1 en slechts 1 Blumklant
 Quit $$ExtraKortingDefault(BLKLNr)
 
 ; Blum geeft vanaf 01/03/2010 extra korting voor sommige kundestammen - PV 25/02/2010
ExtraKortingDefault(BLKLNr)
	Quit:BLKLNr="" ""
	Quit $P($G(^BLProd("R",BLKLNr)),"\",5)	
 
PRIJS(BlumID,BPrijs,BLKLNr,ZonderES) 
 // B-prijs is niet meer gebruikt
 New R,PRIJS,BNP,IC
 If '$D(BLDefJr) Set BLDefJr=1
 Set R=$G(^BLProd("D",BlumID))
 Quit:R="" R
 Set DefKLNr=$$DefaultBlumKlant(BlumID)
 Set:'$G(BLKLNr) BLKLNr=DefKLNr
 Set:"212250;271250"[BLKLNr DefKLNr=BLKLNr ; voor de twee E12 en de E24 klantnrs moet default gelijk zijn aan de opgegeven
 ; Externe specificaties
 Set PrijsRec=""
 If '$G(ZonderES),$D(^BLProd("RP",BLKLNr,BlumID)) Do
 . Set PrijsRec=$P(^BLProd("RP",BLKLNr,BlumID),D,1,8)
 Set BNP=$P(PrijsRec,D,5)
 ; Prijslijst
 Set BLPrijs=$G(^BLProd("D",BlumID,"PPL",DefKLNr)) ; Brutoprijs in de productentabel klant onafhankelijk
 If "P"[BNP Do  ; P=Prijslijst product OF geen externe specificatie
 . Set Rabat=$P($$ROG($P(BLPrijs,D,4),"",BLKLNr),D,2) ; Korting is klantafhankelijk
 . Set $P(PrijsRec,D,1)=$P(BLPrijs,D,1) ; Bruttoprijs
 . Set $P(PrijsRec,D,2)=$P(BLPrijs,D,3) ; Grooteorde
 . Set $P(PrijsRec,D,3)=Rabat ; Korting
 . Set $P(PrijsRec,D,4)=$J($P(PrijsRec,D,1)*(1-Rabat)+.004,0,2) ; Nettoprijs
 . Set $P(PrijsRec,D,8)=$P(BLPrijs,D,5) ; Geldigheidsdatum
 Set $P(PrijsRec,D,7)=$P(BLPrijs,D,6) ; Min Bestelhoeveelheid
 Set $P(PrijsRec,D,9)=$S($G(ZonderES):DefKLNr,1:BLKLNr) ; Blum klantnr
 Set $P(PrijsRec,D,10)=$$ExtraKortingDefault(BLKLNr) ; ExtraKorting
 ;1:BruttoPrijs; 2:GrootteOrde; 3:Korting; 4:NettoPrijs; 5:TypeES; 6:BPrijs; 7:MinBestelhoevelheid; 8:Geldigheiddatum; 9:BlumKlantNr; 10:ExtraKorting
 Quit PrijsRec
 
DefaultBlumKlant(BLID)
 New R,IC
 Set R=$G(^BLProd("D",BLID))
 Quit:R="" ""
 Set IC=$P(R,D,2)
 Set DefKLNr=$S(+IC<4:212250, 1:271250)  ; De IC-code bepaald de Blumklant
 Quit DefKLNr
 
ROG(Kode,Format,BLKLNr) ;Rabat OBER grenze
 New ROG,KLR,IsNetto,MaxCom
 Quit:'$L(Kode) ""
 Set:'$G(BLKLNr) BLKLNr=212250 ; Niet correct indien het gaat over de E24 kunde is dan 271250
 Set IsNetto=$P($G(^BLProd("R",BLKLNr)),D,2)
 If $L(Kode),$P($G(^BLProd("ROG",Kode)),D,3) Set MaxCom=^(Kode)
 Else  Set MaxCom=^BLProd("ROG")
 If $L(Kode),$P($G(^BLProd("ROG",Kode)),D) Set ROG=^(Kode)
 Else  Set ROG=^BLProd("ROG")
 If $L(Kode),$P($G(^BLProd("R",BLKLNr,Kode)),D) Set KLR=^(Kode)
 Else  Set KLR=^BLProd("R",BLKLNr)
 Quit:'$G(Format) $P(ROG,D,1)_D_$P(KLR,D,1)_D_IsNetto_D_$P(MaxCom,D,3)_D_$P(ROG,D,2)
 ; BovenGrens;KlantRabat;IsNettoPrijs;Max Commissie;Omschrijving
 ;Set Format=Kode_" (Max:"_$$EXTNUM^vhDTyp($P(ROG,D),4,"%-",1)_";VH:"_$$EXTNUM^vhDTyp($P(KLR,D,1),4,"%-",1)_")" ; Het max rabat wordt niet meer gebruikt PV - 22-01-04
 Set Format=Kode_" - "_$$EXTNUM^vhDTyp($P(KLR,D,1),4,"%-",1) 
 Quit Format
 ;
 ; Haal produktgegevens
HPG K B S BLID=ID,B(1)=^BLProd("D",ID),$P(B(2),D,25)=D,B(2)=ID
 New Temp S Temp=ID_" "
 K A S PR=0 If '$D(^KPR2(Temp)) Set $E(Temp)=8 If '$D(^KPR2(Temp)) Set $E(Temp)=1 Quit:'$D(^KPR2(Temp))
 S PR=$P(^(Temp),D,1),A(1)=^KPR(PR,0)
 F I=1:1 Q:'$D(^(I))  S A(I+1)=^(I)
 F I="I","J" S A(I)="" I $E($N(^(I)))=I S A(I)=^($N(^(I)))
 S $P(B(2),D,20)=$P(A(2),D,20)+1
 Q
 ;
 ; Verpakking
VRP S KVP=+$P(B(1),D,4),NVP=+$P(B(1),D,5),GVP=+$P(B(1),D,6)
VRP1 I 'GVP S GVP=NVP,NVP=0 I KVP S NVP=KVP,KVP=0 G VRP1
 Q
 ;
 ; Bold
BLD I $D(ver($P(U2,U,16))) W @FMTB
 Q
 ;
 ; justify numeriek
JUN S $P(U2,U,17)=K,U1=17,FN(4)="N+" D FMT S U3=$J($P(U2,U,17),8)
 Q
 ;
 ; Formatering
FMT X "S FN(1)="_+$P(U2,U,U1) S FN(2)=20,FN(3)=DC D FN^PROC S $P(U2,U,U1)=R K FN
 Q
 ;
 ;Help
HLP D SA S HLP(1)=$P($T(T20),U,2),HLP(2)=$P($T(T20),U,3),HLP(3)=8,HLP(6)="" D HLP^HELP
 I "\S\O\B\P\I\A\N\L\V\HELP\?\,\-\"'[(D_R_D) S R=VTB
 S VTB="",T=106,SW5=1,U4=R D ALG1 S R=U4
 Q
 ;
 ; Beschrijving
BES S DL(1)="BES",BES(1)="bes(" G BES3:VTB=U4&$D(bes),BES2:$D(bes) D SA S VNR=0,BES="B"
BES1 S BES=$N(^BLProd("D",ID,BES)) I $E(BES,1)="B" S U2=$E(BES,2)_D_^(BES),VNR=VNR+1,bes(VNR)=U2 G BES1
BES2 D WL^PROC
BES3 D SL^PROC S VTB=U4
 Q
 ;
 ; Next
NXT 
 N Dir
 S Dir=U4
 D SA1
NXT1 S PC=$P(B(1),D,1),PCC=$$UPTRIMAN^vhRtn1(PC)
 S NXT=PCC_D_ID
NXT2  S NXT=$O(^BLProd("I",NXT),$S(Dir="(":-1,1:1)) G NXT2:NXT=""
 S ID=$P(NXT,D,2) G NXT2:'$$CHECK^BLPROD(ID,1)
 D HPG,RET,ver I VTB="V" G NXT2:'$D(ver) D ALG S U4=VTB,VTB="" D VER
 S U4=VTB
 Q
 ;
 ; Opmerkingen
OPM S DL(1)="OPM",OPM(1)="opm(" G OPM3:VTB=U4&$D(opm),OPM2:$D(opm) D SA S VNR=0,LineNr=""
OPM1 S LineNr=$O(^BLPrTxt("O",ID,"DE",LineNr)) I LineNr'="" S U2=^(LineNr),VNR=VNR+1,opm(VNR)=U2 G OPM1
OPM2 D WL^PROC
OPM3 D SL^PROC S VTB=U4
 Q
 ;
 ; Set
SET S DL(1)="SET",SET(1)="set(" G SET3:VTB=U4&$D(set),SET2:$D(set) D SA S VNR=0,SET="S"
SET1 S SET=$N(^BLProd("D",ID,SET)) G BES2:$E(SET,1)'="S" S U2=^(SET)
 I $D(^BLProd("D",$P(U2,D,1))) S $P(U2,D,3)=$P(^($P(U2,D,1)),D,1)
 S $P(U2,D,1)=$E($P(U2,D,1),1)_"."_$E($P(U2,D,1),2,4)_"."_$E($P(U2,D,1),5,7)_"."_$E($P(U2,D,1),8)
 S VNR=VNR+1,set(VNR)=U2 G SET1
SET2 D WL^PROC
SET3 D SL^PROC S VTB=U4
 Q
 ;Staffeling voor rugwanden
STAF Set DL(1)="BLSTAF"
 G STAF3:VTB=U4&$D(List)
 New PRNr Set PRNr=ID
 Kill List
STAF2 Do ^BLSTAF,SA
STAF3 Do SL^PROC S VTB=U4
 Quit
 ;Prijszetting voor andere klanten
KLANT Set DL(1)="BLKLANT"
 G KLANT3:VTB=U4&$D(List)
 New PRNr Set PRNr=ID
KLANT2 Set KLNr="",Cnt=0
 Kill List
 For  Set KLNr=$O(^BLProd("R",KLNr)) Quit:KLNr=""  Do:KLNr'=271250
 .Set Prijs=$$PRIJS(BLID,"",KLNr)
 .Quit:Prijs=""
 .Set Cnt=Cnt+1
 .Set List(Cnt)=KLNr_D_Prijs
 Set FP=1701 Write @F,@F1
 Do INIT^PROC("BLKLANT")
 Do WL^PROC
 Do SA
KLANT3 Do SL^PROC S VTB=U4
 Quit
 ;
 ; Verschillen (ophalen)
ver G ver2:'$D(A) S VNR=0,VER=200
 S BPrijs=$P(A("J"),D,18)
 S PRIJS=$$PRIJS^BLPRGEG(BLID,BPrijs,$P(A("J"),D,4))
 Do VRP
 If BPrijs,GVP>$P(B(1),D,15) Set GVP=NVP,NVP=KVP
ver1 S VER=VER+1,U2=$P($T(@("T"_VER)),U,2,99) G ver2:U2="" I $L($P(U2,U,4)) X $P(U2,U,4)
 X "S $P(U2,U,2)="_$P(U2,U,2),"S $P(U2,U,3)="_$P(U2,U,3) G ver1:$P(U2,U,2)=$P(U2,U,3)
 I $L($P(U2,U,5)) X $P(U2,U,5)
 S VNR=VNR+1,ver(VNR)=$P(U2,U,1)_D_$P(U2,U,2)_D_$P(U2,U,3)_D_$P(U2,U,7)_D_$P(U2,U,8),ver($P(U2,U,6))="" G ver1
ver2 Q
 ;
 ; verschillen (tonen)
VER S DL(1)="VER",VER(1)="ver(" G VER2:VTB=U4&$D(ver) D SA
 D WL^PROC,O1:'$D(ver)&$D(A),O2:'$D(A)
VER2 D SL^PROC S VTB=U4
 Q
 
COPYPR New Input,Key,Val,Rec
 Goto COPYPR2:'PR!'$D(ver),COPYPR2:'$D(^KPR(PR))
 Set Input=$$^vhTXTPOP("BLPRGEG","COPYPR")
 Goto COPYPR2:Input'="S"&(Input'="H")
 Lock ^KPR(PR):1 Else  Do LDISP^vhLock("^KPR(PR)","Produkt") G COPYPR2
 Do DELIND^PRODUKT2(PR)
 For I=1:1:99 Quit:'$D(ver(I))  Do
 .Set Rec=ver(I),Key=$P(Rec,D,4+(Input="S"))
 .Set:Key="" Key=$P(Rec,D,4)
 .Quit:Key=""
 .Set Val=$P(Rec,D,2)
 .If $P(Key,".",3)["N" Do  ; Numeriek
 ..Set Val=+$TR(Val,",.",".") ; De opgeslagen getallen zijn reeds geformateerd
 ..Set:+$P(Val,".",2) Val=$J(Val,0,2)
 .If $P(Key,".",3)="N",'+Val Quit  ; Nul is niet toegelaten
 .If $P(Key,".",3)="NB",'+Val Set Val="" ; Nul wordt blanko        
 .If $P(Key,".")="J" Set $P(Key,".")=$O(^KPR(PR,"J")) Quit:$E(Key)'="J"
 .Set $P(^KPR(PR,$P(Key,".")),D,$P(Key,".",2))=Val
 Do BLDIND^PRODUKT2(PR)
 Do RECALC^PRODUKT2(PR)
 Kill ver Set VER(7)=1,VER(9)=0,VTB="C" D HPG,ver,ALG
COPYPR2 Set R="V" Quit
 ;
 ; Raadplegen produkt VH
RPL S R=VTB
 I PR,$D(^KPR(PR)) S PARAM=PR G BL^RPLSW
 D O2 G 21
 ;
 ; Reset tabellen
RET S (BES(7),OPM(7),SET(7),VER(7),BLSTAF(7))=1
 K bes,opm,set,ver,List
 Q
 ;
 ; Begin
BEGIN D IN I $D(PARAM) S:$L($P(PARAM,D,1)) ID=$P(PARAM,D,1) S:$L($P(PARAM,D,2)) R=$P(PARAM,D,2) K PARAM
 G 11:$L(ID)
 S BPROG=$ZN
 ;
1 S R="K\2000\"_R D ^BLSELPR S:K="." K="-"
 I K="-" G END:'$L(ID),21:VTB="" S DL(2)=20 D WL^PROC S R=VTB G 21
 S ID=K I ID=IDX S R=VTB,VTB="" G 21
11 D HPG,RET,ver
13 D ALG
 I $D(U4),U4'="COM" S R=U4,VTB="" G 21:$L(R) S U4=" " D SA S U4=R,FP=2203 W @F,@F1 G 21
 ;
 ; Input
 S FP=2203+F60 W @F,$P($T(T3),U,2),":",!?2,$P($T(T3),U,3)
2 I '$D(IK) D CVL^PROC S IK(1)=R
 D IK^PROC1
21 Set Input=R
 If Input="COM" Do CALL^vhMenu("BLPRGEG")
 Do EXEC^vhMenu("BLPRGEG",.Input)
 Set R=Input
 S IDX=ID
 G END:R="-",1:R="P"!(R="I")
 S U4=R
 I U4="B" D BES G 21
 I U4="L" G RPL
 I U4="("!(U4=")") D NXT G 21:VTB="V",13
 I U4="O" D OPM G 21
 I U4="C"&(VTB="V") D COPYPR G 21
 I U4="S" D SET G 21
 I U4="T" D STAF G 21
 I U4="K" D KLANT G 21
 I U4="V" D VER G 21
 ;I U4="?"!(U4="HELP") D HLP G 21
 I U4="," G BC^RPLSW:$D(STACK),END
 G 2:VTB="" S R=VTB G 21
 ;
END Q
 ;