RPLPR4 ;RAADPLEGEN PRODUKT ;RPLPR; Do naar OUTPUT, PROC2 - Quit naar RPLPR1 [ 10/07/2003  8:50 AM ]
 Q
 ;
OUTPUT New K R *K:1
 Set List=$$GIVELIST^vhPRINTER($$IO^cQ5,"CA")
 Do ^OUTPUT($S($L(List):"PT",1:"M"),"-",$S(K:$C(K),1:""))
 Quit
REFRESH Set DL(2)=20 D WL^PROC
 Set FP=101 Write @F,@F2
 Quit
 ;
 ;Prijsuitzonderingen
UTZ If '$D(^HULP($J,"P"_PR,"U")) W *7 Quit
 S $P(UTZ(11),D,2)="Produkt "_$P(^KPR(PR,0),D,1)
 S $P(UTZ(11),D,1)="Prijsuitz, nivo : "_$P("Hoofdgroep;Groep;Subgroep;Produkt;Beperkt tot klas",";",NivNr)
 Do OUTPUT,REFRESH
 Q
 ;
 ;Verkoopanalyze
VKA If '$D(^AKANAL(PR)) W *7 Quit
 N vka
 M vka=VKA
 N VKA
 M VKA=vka
 S $P(VKA(2),D)="2;C;L;20;;|;;$S(X:""R""_$TR($J($P(^KKL(^KK1(X),0),D,20),2),"" "",0),1:"""")"
 S VKA(11)="Verkoopanalyze"_D_"Produkt "_$P(^KPR(PR,0),D,1)
 S VKA(10)="VKACB^RPLPR4"
 Do OUTPUT
 M VKA=vka
 K VKA(10)
 Do REFRESH
 Q
 ;
VKACB(Ref) 
 Q:Ref'="E" ""
 S FL(3)="" I $D(^AKANAL(PR))#10 S $P(FL(3),D,4)=$P(^(PR),D,1),$P(FL(3),D,12)=$P(^(PR),D,3)
 Quit "BR;\;"
 ;
 ;Verkoopanalyze leverancier
VAL If '$D(^AKANAL(PR)) W *7 Quit
 S VAL(11)="Verkoopanalyze"_D_"Produkt "_$P(^KPR(PR,0),D,1)
 S VAL(10)="VALCB^RPLPR4"
 Do OUTPUT
 K VAL(10)
 Do REFRESH
 Q
 ;
VALCB(Ref) 
 Q:Ref'="E" ""
 S FL(3)="" I $D(^AKANAL(PR))#10 S $P(FL(3),D,4)=$P(^(PR),D,1),$P(FL(3),D,12)=$P(^(PR),D,3)
 Quit "BR;\;"
 ;
 ;Orders
OOT If '$D(^HULP($J,"P"_PR,"O")) W *7 Quit
 S OOT(11)="Openstaande orders/toeleveringen"_D_"Produkt "_$P(^KPR(PR,0),D,1)
 Do OUTPUT,REFRESH
 Q
 ;
 ;PAKKETTEN / KLANT PRODUKTREFERENTIES
PRF If '$D(^HULP($J,"P"_PR,"R")) W *7 Quit
 S PRF(11)="Pakketten / Klant referenties"_D_"Produkt "_$P(^KPR(PR,0),D,1)
 Do OUTPUT,REFRESH
 Q
 ;Stock flow (Historieken)
STF If '$D(^HULP($J,"P"_PR,"F")) W *7 Quit
 S STF(11)="Historieken"_D_"Produkt "_$P(^KPR(PR,0),D,1)
 Do OUTPUT,REFRESH
 Q
 ;
 ;Maandomzetten
MOM If '$D(^HULP($J,"P"_PR,"M")) W *7 Quit
 S MOM(11)="Maandomzetten"_D_"Produkt "_$P(^KPR(PR,0),D,1)
 Do OUTPUT,REFRESH
 Q
 ;
MENU 
 New Input
 Do CALL^vhMenu("RPLPR","F*")
 Set R=$G(Input)
 Quit
 ;
SPEC 
 New Input,Menu
 Quit:'$D(DL)
 Set Menu="RPLPRSPEC"
 Do CALLSPEC^vhMenu(@DL(1)@(3)+@DL(1)@(6)-1_";80",Menu,"")
 Set R=$G(Input)
 Quit
 ;
CHKMENU(Menu) 
 New AddMenu,KLNr,IdentNr
 Set AddMenu=0
 If Menu="FLOW" Do
 .If VTB'="O",$E($O(^KPR(PR,"W")))="W" Set AddMenu=1 Quit
 .If VTB="O",$L($P($G(^HULP($J,"P"_PR,"O",OOT(6))),D,50)),$L($$GETORD^FLOWKLAS($P(^(OOT(6)),D,50))) Set AddMenu=1 Quit
 .If ##class(ProdHist.ChargeTrace).ProductHasChargeTrace(PR) Set AddMenu=1
 If Menu="LINK" Do
 .If $L(##class(BL.Prod.OptiBox.Diverse).HasOptiData(PR)) Set AddMenu=1 Quit
 .Set IdentNr=$TR($P(^KPR(PR,2),D,25),".","")
 .If $D(^BLProd("D",IdentNr)) Set AddMenu=1 Quit
 .Set $E(IdentNr)=0
 .If $D(^BLProd("D",IdentNr)) Set AddMenu=1
 .If VTB="H",'$D(PRHIST),$D(^HULP($J,"P"_PR,"F",STF(6))) Set KLNr=$P(^(STF(6)),D,7)
 .If VTB="H",$D(PRHIST),$D(^HULP($J,"P"_PR,"PRHIST",PRHIST("SELECT"))) Set KLNr=$P(^(PRHIST("SELECT"),1),D,6)
 .If VTB="M",DEM,$D(^HULP($J,"P"_PR,"M",BP,DEM(6))) Set KLNr=$P(^(DEM(6)),D,1)
 .If VTB="O",$D(^HULP($J,"P"_PR,"O",OOT(6))) Set KLNr=$P(^(OOT(6)),D,2)
 .If VTB="U",$P($G(^HULP($J,"P"_PR,"U",UTZ(6))),D,1) Set KLNr=$P(^(UTZ(6)),D,1)
 .If VTB="R",$P($G(^HULP($J,"P"_PR,"R",PRF(6))),D,2) Set KLNr=$P(^(PRF(6)),D,2)
 .If VTB="V",$D(^AKANAL(PR,VKA(6))) Set KLNr=$P(^(VKA(6)),D,2)
 .If $G(KLNr),$D(^KK1(KLNr)) Set AddMenu=1
 Quit AddMenu
 ;
CHKITEM(Item) 
 New AddItem,KLNr,IdentNr,ORDNr,TOENr
 Set AddItem=0
 If Item="BLUM" Do
 .Set IdentNr=$TR($P(^KPR(PR,2),D,25),".","")
 .If $D(^BLProd("D",IdentNr)) Set AddItem=1 Quit
 .Set $E(IdentNr)=0
 .If $D(^BLProd("D",IdentNr)) Set AddItem=1 Quit
 If Item="KLANT" Do
 .If VTB="H",$D(^HULP($J,"P"_PR,"F",STF(6))) Set KLNr=$P(^(STF(6)),D,7)
 .If VTB="M",DEM,$D(^HULP($J,"P"_PR,"M",BP,DEM(6))) Set KLNr=$P(^(DEM(6)),D,1)
 .If VTB="O",$D(^HULP($J,"P"_PR,"O",OOT(6))) Set KLNr=$P(^(OOT(6)),D,2)
 .If VTB="U",$P($G(^HULP($J,"P"_PR,"U",UTZ(6))),D,1) Set KLNr=$P(^(UTZ(6)),D,1)
 .If VTB="R",$P($G(^HULP($J,"P"_PR,"R",PRF(6))),D,2) Set KLNr=$P(^(PRF(6)),D,2)
 .If VTB="V",$D(^AKANAL(PR,VKA(6))) Set KLNr=$P(^(VKA(6)),D,2)
 .If $G(KLNr),$D(^KK1(KLNr)) Set AddItem=1
 If Item="ORDER" Do
 .If VTB="O" Set ORDNr=$P($G(^HULP($J,"P"_PR,"O",@DL(1)@(6))),D)
 .If ORDNr,$D(^KO1(ORDNr,"F")) Set AddItem=1
 If Item="TOELEV" Do
 .If VTB="O" Set TOENr=$P($G(^HULP($J,"P"_PR,"O",@DL(1)@(6))),D)
 .If TOENr,$D(^KTO1(TOENr)) Set AddItem=1
 Quit AddItem
 ;
PRINT 
 If VTB="O" Goto OOT
 If VTB="H" Goto STF
 If VTB="V" Goto VKA
 If VTB="M" Goto MOM
 If VTB="R" Goto PRF
 If VTB="U" Goto UTZ
 If SW2=5 D
 .New Locals
 .Set Locals("PR")=PR,Locals("SCR")=SW2
 .Do DO^vhPROGRAM("^KPFI11")
 .Set FP=2103+F60
 .Write @F,@F1
 Quit
 ;
DPRINT(Type) 
 New Nummer
 If Type="O" Set Nummer=$P(^HULP($J,"P"_PR,"O",@DL(1)@(6)),D)
 If Type="T" Set Nummer=$P(^HULP($J,"P"_PR,"O",@DL(1)@(6)),D)
 Do STORE^vhTERMINA(),EXTERN^DCPRINT(Type,Nummer,0,0,1),REFRESH^vhTERMINA()
 Quit
 ;
MAIL 
 New MailId
 Set Locals("PR")=PR,Locals("VTB")=$G(VTB),Locals("Refer")="PR\"_PR_"\R\"_$G(VTB)
 Do XECUTE^vhPROGRAM("Set MailId=$$EXTERN^vhMAIL(""PR"",PR,"""","""","""",.Refer)")
 Quit
 ;