PREXP ;Produktprijslijst voor VTW's ;[ 11/07/2001  1:52 PM ]
 ;
 ; Agenda format : Pagesetup 66%
 ; A4 formaat : Pagesetup 92%
 ; Printer instellinen : Courier 10
 ;
 If '$D(Q) S Q="K" D ^cA604,INIT^vhTERMINA
 Set %J=$$%J^vhRtn1()
 Set FP=202
 Write @F11,@F1,@F,@F4,$P($T(+1),U,2),@F5
 Set DOC="Produktprijslijst "
 Set SELK=0,LSTX="K"
SELECT Do PP^KPSEL Quit:K="-"
SELLEV Set R=$$SELECT^LEVER(1,"","Beperkt tot leverancier : ")
 Goto SELECT:R="-"
 Set LevNr=""
 Set FP=1501 Write @F,@F2
 If R Set LevNr=R Write "Leverancier : "_LevNr
SCHADUW Set R=$$ASKL^vhINP("PREXP","SCHADUW")
 If R'="N",R'="S",R'="C" Goto SELLEV
 Set Schaduw=$S(R="N":0,R="C":0,1:1)
 Set Conc=R="C"
OUTPUT Set Output=$$ASKL^vhINP("PREXP","OUTPUT")
 If Output'="S",Output'="P",Output'="T",Output'="M" Goto SCHADUW
 Set Taal=$S(Output="T":$$ASKL^vhINP("PREXP","TAALLANGTEKST"),1:"")
 If $L(Taal),Taal'="N",Taal'="F" Goto OUTPUT
 Set Munt=$$MUNTKODE^vhRtn1("EUR")
 Set BeperktPrijsLijst=1
 Kill ^HULP(%J)
 Set (TProd,SProd)=0,FP=2001
 Write @F,@F1,!!!,"Produkten verwerkt :"
 Set KortT=""
 Set KHS=HG If HG'=0 Set KHS=$O(^KPH(HG),-1)
 Set KGS=GR If GR'=0 Set KGS=$O(^KPH(HG,GR),-1)
 Set KSS=SG If SG'=0 Set KSS=$O(^KPH(HG,GR,SG),-1)
 For  Set KHS=$O(^KPH(KHS)) Quit:KHS=""!(KHS]HGX)  Do
 .For  Set KGS=$O(^KPH(KHS,KGS)) Quit:KGS=""!(KGS]GRX)  Do
 ..For  Set KSS=$O(^KPH(KHS,KGS,KSS)) Quit:KSS=""!(KSS]SGX)  Do
 ...For  Set KortT=$O(^KPH(KHS,KGS,KSS,"  ",KortT)) Quit:KortT=""  Do
 ....Set PRNr=^(KortT)
 ....If '(TProd#100) Set FP=2320 Write @F,TProd,"/",SProd
 ....Set TProd=TProd+1
 ....Quit:$P(^KPR(PRNr,1),D,25)  ; NON-aktief
 ....Quit:$E($P(^KPR(PRNr,2),D,25),1)="7"  ; DO's
 ....Quit:$E($P(^KPR(PRNr,2),D,25),1)="6"  ; Kind prod
 ....Quit:$P(^KPR(PRNr,0),D,3)'=""  ; Generisch of afgeleid
 ....Quit:BeperktPrijsLijst&&('$P(^KPR(PRNr,3),D,3)) ; Prijslijst product
 ....;Quit:$E($P(^KPR(PRNr,2),D,25),1)="1"  ; tijdelijk
 ....;Quit:$E($P(^KPR(PRNr,2),D,25),1)="2"
 ....;Quit:$E($P(^KPR(PRNr,2),D,25),1)="3"
 ....;Quit:'$P(^KPR(PRNr,1),D,20)  ; NIET-stock prod - tijdelijk
 ....;If LevNr Quit:'$D(^KPR(PRNr,"J"_LevNr))
 ....Set Rec0=^KPR(PRNr,0)
 ....Set Rec1=^KPR(PRNr,1)
 ....Set KeyJ=$O(^KPR(PRNr,"J"))
 ....Set RecJ=^KPR(PRNr,KeyJ)
 ....Set SProd=SProd+1
 ....Set NormP=$$PRIJZEN(PRNr,Munt,Schaduw)
 ....Set ^HULP(%J,KSS_KortT_1)=PRNr_D_$P(Rec0,D,1)_D_$S($P(Rec1,D,20):"ST",1:"")_D_$P(Rec1,D,19)_D_NormP
 Do INIT^PROC("PREXP"_$S(Conc:"C",1:"")_$S($L(Taal):"T",1:""),"PREXP")
 Set PREXP(11)="Prijslijst in munt "_$S(Munt="MTL":Munt,1:$$MUNT^vhRtn1(Munt,1))
 Set PREXP(5)=$S(Conc:95,1:81)
 Set PREXP(4)="86;5;3;73;1;82"
 Do RL^PROC1
 Do PRINT^OUTPUT(.PREXP,Output,"S")
 Kill ^HULP(%J)
 Quit
 
PRIJZEN(PRNr,Munt,Schaduw) 
 New Prijs,Rec,KSProd
 Set Schaduw=$S($G(Schaduw):"S",1:"N")
 ;Set KSProd=$$ISPROD^KS(PRNr,Schaduw)
 For J=1:1:7 Do
 .;If '$G(KSProd),J<3 Set Prijs=""
 .Set Prijs=$$PROD^KPRIJS(PRNr,$E("LRSBGCP",J),"","","","",Schaduw)
 .Set $P(Rec,D,J*2)=$P(Prijs,D,1)_D_$S($P(Prijs,D,3)="H":"%",1:"")
 Quit Rec
 
LangTekst(PRNr,Taal)
 New LangTekst
 Set LangTekst=$$GETOMSCH^PRODUKT2(PRNr,$G(Taal,"N"))
 For  Quit:$E(LangTekst,$L(LangTekst))'=D  Set $E(LangTekst,$L(LangTekst))=""
 Set LangTekst=$TR(LangTekst,D," ")
 Quit LangTekst