cwRPLPR2 ;RAADPLEGEN PRODUKTEN ;RPLPR; Quit naar RPLPR1 [ 11/29/2003   8:10 AM ]
 G YZ
 ;
T2 ; Geen leverancier voor dit produkt 
T3 ; Geen verkoopanalyze voor dit produkt 
T4 ; Geen weekverkoop voor dit produkt 
T5 ; Geen historiek voor dit produkt 
T6 ; Geen maandverkoop voor dit produkt 
T7 ; Geen verkopen voor de geselekteerde maand 
T8 ; Geen openstaande orders/toeleveringen voor dit produkt 
T9 ; Produkt onbekend bij Blum 
T10 ; Geen prijzen ingevuld 
T11 ;     *** VERVOLG ***
T12 ; (C&C)
T13 ;STORNO
T14 ;BEGINSTOCK
T15 ;BEF;NLG;EUR;MTL
T16 ; Geen pakketten gevonden waartoe dit produkt behoort.
 ;
O1 S K=$P($T(T2),U,2) G OY
O2 S K=$P($T(T3),U,2) G OY
O3 S K=$P($T(T4),U,2) G OY
O4 S K=$P($T(T5),U,2) G OY
O5 S K=$P($T(T6),U,2) G OY
O6 S K=$P($T(T7),U,2) G OY
O7 S K=$P($T(T8),U,2) G OY
O8 S K=$P($T(T9),U,2) G OY
O9 S K=$P($T(T10),U,2) G OY
O10 S K=$P($T(T16),U,2) G OY
OY S FP=2403 W @F,@F1,@FMTI,K,@FMTi,@F0
OZ Q
 ;
XT S R=$$INTDATE^vhDTyp(R)
 Q
 ;
 ;Write list
WL K DL(2),DL(3) D WL^PROC
 Q
 ;
 ;Verwijder blanko's
VB I $E(@I,1)=" " S @I=$E(@I,2,99) G VB
 Q
 
LEV New Cnt,NoSa,KLNr
 Kill ^HULP($J,"P"_PR,"S5")
 Set NoSa="N",(KLNr,VolgNr)="",Cnt=0
 For  Set KLNr=$O(^PRPUTZ(NoSa,PR,KLNr)) Quit:KLNr=""  Do
 .For  Set VolgNr=$O(^PRPUTZ(NoSa,PR,KLNr,VolgNr)) Quit:VolgNr=""  Do
 ..Set Cnt=Cnt+1
 ..Set ^HULP($J,"P"_PR,"S5",Cnt)=KLNr_D_VolgNr_D_^PRPUTZ(NoSa,PR,KLNr,VolgNr)
 If '$D(^HULP($J,"P"_PR,"S5")) Set FP=1901 Write @F,@F1 Quit
 Do INIT^PROC("RPLPRLEV","PRLEV")
 Do WL^PROC
 Quit
 ;
 ;Prijstabel
PTA New R,KatPr,LPrs,VorkP,MTL,I,J,Munt,Rnd,Krt,Schad,DispSchad,KSRec,KSRecS,MTLS,NMunt,SMunt,NPrijs,SPrijs,Munten
 S MTL=$P(^KPR(PR,$O(^KPR(PR,"J"))),D,1),MTL=$P(^KLE(^KL1(MTL),0),D,11)
 S Schad=+$P($G(^KLPUTZ("AS")),D)
 If Schad Do
 .Set MTLS=$P(^KPR(PR,1),D,3) Set:MTLS=MTL MTLS=""
 .Set NPrijs=^KPR(PR,2)
 .Set Prijs=$O(^KPR(PR,"J")) Set Prijs=$S($E(Prijs)="J":^KPR(PR,Prijs),1:"")
 .Set DispSchad=""
 .If Schad For I=1:1:5 Do
 ..If $P(NPrijs,D,I+2)'="",+$P(NPrijs,D,I+2)'=+$P(Prijs,D,$P("19;9;27;24;21",";",I)) Set DispSchad=1
 Set KSRec=$$STAFFEL^KS(PR)
 Set KSRecS=$$STAFFEL^KS(PR,"S")
 Set Munten=$P($T(T15),";",2,99)
 F I=1:1:$L(Munten,";") D
 .S Munt=$P(Munten,";",I)
 .S ^HULP($J,"P"_PR,"PC",I*(2+Schad)-1-Schad+(I-1*Schad))=""
 .S ^HULP($J,"P"_PR,"PC",I*(2+Schad)-Schad+(I-1*Schad))=$S(Munt="MTL":"MTL("_$$MUNT^vhRtn1(MTL,1)_")",1:Munt)
 .S:Schad ^HULP($J,"P"_PR,"PC",I*(2+Schad)+1-Schad+(I-1*Schad))="Schaduw"_$S(Munt="MTL":$S($L(MTLS):"("_$$MUNT^vhRtn1(MTLS,1)_")",1:""),1:"")
 .S Munt=$S(Munt="MTL":$$MUNT^vhRtn1(MTL,1),1:Munt)
 .I I'=$L(Munten,";"),Schad S ^HULP($J,"P"_PR,"PC",I*(2+Schad)+2-Schad+(I-1*Schad))=""
 .F J=1:1:5 D
 ..Set (NPrijs,Prijs)=""
 ..S:$L(KSRec)!(J>2) (NPrijs,Prijs)=$$PROD^KPRIJS(PR,$E("EKLSG",J),"",$$MUNTKODE^vhRtn1($P(Munten,";",I)))
 ..S $P(^HULP($J,"P"_PR,"PC",I*(2+Schad)-Schad+(I-1*Schad)),D,J*2)=$P(Prijs,D)_D_$S($P(Prijs,D,3)="H":"%",1:"")
 ..Quit:'Schad
 ..S Prijs=""
 ..S:$L(KSRecS)!(J>2) Prijs=$$PROD^KPRIJS(PR,$E("EKLSG",J),"",$$MUNTKODE^vhRtn1($P(Munten,";",I)),"","","S")
 ..Q:'DispSchad
 ..S $P(^HULP($J,"P"_PR,"PC",I*(2+Schad)+1-Schad+(I-1*Schad)),D,J*2)=$P(Prijs,D)_D_$S($P(Prijs,D,3)="H":"%",1:"")
 ..S R=$P(^HULP($J,"P"_PR,"PC",I*(2+Schad)-Schad+(I-1*Schad)),D)
 ..If $P(R,"(")="MTL" Do
 ...Set NMunt=$P($P(R,")"),"(",2)
 ...S R=$P(^HULP($J,"P"_PR,"PC",I*(2+Schad)+1-Schad+(I-1*Schad)),D)
 ...;Set SMunt=$P($P(R,")"),"(",2) Set:SMunt="" SMunt=NMunt
 ...Set SMunt=MTL Set:SMunt="" SMunt=NMunt
 ..Else  Set (NMunt,SMunt)=R
 ..S NPrijs=$P(^HULP($J,"P"_PR,"PC",I*(2+Schad)-Schad+(I-1*Schad)),D,J*2)
 ..S SPrijs=$P(^HULP($J,"P"_PR,"PC",I*(2+Schad)+1-Schad+(I-1*Schad)),D,J*2)
 ..S R=$$%NS^KP0NL(NPrijs,SPrijs,$$MUNTKODE^vhRtn1(NMunt),$$MUNTKODE^vhRtn1(SMunt))
 ..Set:$L(R) R=$$EXTNUM^vhDTyp(R,9,"+",2)_"%"
 ..S Prijs=$$PROD^KPRIJSS(PR,$E("EKLSG",J),"",$$MUNTKODE^vhRtn1($P(Munten,";",I)),"","","S")
 ..S R=$P(Prijs,D)_D_$S($P(Prijs,D,3)="H":"%",1:"")
 ..S $P(^HULP($J,"P"_PR,"PC",I*(2+Schad)+2-Schad+(I-1*Schad)),D,J*2)=R
PTA1 S VNR=I D PTAWL,O9:'VNR
 Quit
PTAWL ; Label aanpassen aan KS-produkt
 New KSRec,KSRecS
 Set KSRec=$$STAFFEL^KS(PR)
 Set KSRecS=$$STAFFEL^KS(PR,"S")
 Set:$L(KSRec) PTA(8)="Munt           |   Eenheid  | KV:"_$J($P(KSRec,D,2),7)_" |Lijst:"_$J($P(KSRec,D),6)_"|      Spil  |     Groot"
 Set:'$L(KSRec) PTA(8)="Munt           |            |            |     Lijst  |      Spil  |     Groot"
 Do WL
 If KSRec'=KSRecS Do
 .Set FP=2001
 .Write:$L(KSRecS) @F,@FMTI,"Schaduw        |   Eenheid  | KV:",$J($P(KSRecS,D,2),7)," |Lijst:",$J($P(KSRecS,D),6),"|      Spil  |     Groot ",@FMTi
 .Write:'$L(KSRecS) @F,@FMTI,"Schaduw        |            |            |     Lijst  |      Spil  |     Groot ",@FMTi
 Q
 ;
 ;Weekverkoop
WVK S (WVK(9),VNR)=0,WK=DJ_"."_$E(100+%WK,2,3) G WVK2
WVK1 I +$P(WK,".",2)=+%WK D WL:VNR'>17,O3:'$D(^HULP($J,"P"_PR,"W")) G WVK3
WVK2 S WK=$J(WK-.01,0,2) S:'$P(WK,".",2) WK=DJ-1_".54" S WK=WK_" " G WVK1:'$D(^KSPW(PR,WK)) S U2=^(WK)
 S VNR=VNR+1 I VNR=18 D WL
 S ^HULP($J,"P"_PR,"W",VNR)=$E(WK,1,4)_"/"_$E(WK,6,7)_D_$P(U2,D,7,10) G WVK1
WVK3 S WVK(9)=VNR Q
 ;
 ;Verkoopanalyze
VKA S U2="" I $D(^AKANAL(PR)) S U2=^(PR)
 Set VKA(2)=VKA(2,1),VKA(8)=VKA(8,1) S:U2="MOK" VKA(2)=VKA(2,2),VKA(8)=VKA(8,2)
 S:VKA(3)<10 VKA(3)=$S(U2="MOK":8,1:9)
 K VKA(4)
 I U2'="",U2'="MOK" S U2="\\\"_$P(U2,D,1)_"\\\\\\\\"_$P(U2,D,3)
 I U2'="MOK" S FL(1)=VKA(2),FL(2)=8+(VKA(3)>9*2)*100+1,FL(3)=U2 W @FMTU D FL^PROC W @FMTu
 S VKA(9)=$O(^AKANAL(PR,""),-1) D WL
 I '$D(^AKANAL(PR)) D O2
 Q
 ;
 ;Stock flow
STF New FLim,Chk
 S (STF(9),MAXF)=0 G STF2:VRV S VNR=0,IND="H9999",PST=$P(^KPR(PR,0),D,14),MAXF=203
STF1 S IND=$O(^KPR(PR,IND),-1) I $E(IND)="H",IND'="H" S VVK=$L(^(IND),D) G STF2
 I VRV,VNR-STF(6)<18 S (STF(6),FDL(7))=VNR-16
 I VNR S U2="\ \"_PST_"\\\"_$P($T(T14),U,2),VNR=VNR+1,^HULP($J,"P"_PR,"F",VNR)=U2
 D WL,O4:'$D(^HULP($J,"P"_PR,"F"))
 S STF(9)=VNR G STF6
STF2 S U2=^KPR(PR,IND)
 S FLim=$G(^HULP($J,"STFLIM"))
STF3 S VVK=VVK-1 G STF1:'VVK S VRK=$P(U2,D,VVK),UDT=$E(VRK,5,6)_"."_$E(VRK,3,4)_"."_$E(VRK,1,2)
 S UA=$E($P(VRK,"#",1),8,99),UR=$P(VRK,"#",3),(UKC,REF)="",KOD="M" S:$E(VRK,7)#2 UA=-UA
 G STF4:UR'?1"U"6N S UR=$E(UR,2,7)
 I $D(^KO1(UR,"F")) S UKC=^("F"),KOD="L" S:$L($P(UKC,D,3)) UR=$P(UKC,D,3),KOD="C" S UKC=+$P(UKC,D,1) G STF5
STF4 I $L(UR),$D(^KU1(UR,"F")) D  G STF5
 .S UKC=^("F"),KOD="L" S:$L($P(UKC,D,2)) UR=$P(UKC,D,2),KOD="F" S:$L($P(UKC,D,3)) KOD=$P(UKC,D,3)
 .S UKC=+$P(UKC,D,1)
 I UR[$P($T(T13),U,2) S UKC=$P($P(UR,"(",2),")",1),UR=+UR
 I UR,UR?.6N S KOD=$S(UR>300000:"S",1:"T") S:KOD="S" REF=$P($T(T13),U,2) G STF5
 S REF=UR,UR=""
STF5 I $L(UKC),$D(^KK1(UKC)) S:$L(REF) REF=REF_" (" S REF=REF_$P(^KKL(^(UKC),0),D,2) S:REF[" (" REF=REF_")"
 I KOD="C" S KOD="F",REF=REF_$P($T(T12),U,2)
 If $L(FLim) Do  Goto:'Chk STF3
 .Set Chk=1
 .If $P(FLim,D)="B",$E(VRK,7)=2,$P(FLim,D,2)'=UKC Set Chk=0
 .If $P(FLim,D)="M",$E(VRK,7)<3 Set Chk=0
 .If $P(FLim,D)="K"!($P(FLim,D)="B"),$E(VRK,7)'=2 Set Chk=0
 .If $P(FLim,D)="L",$E(VRK,7)'=1 Set Chk=0
 .Set PST=0
 S VNR=VNR+1 I VNR=18 D WL
 S ^HULP($J,"P"_PR,"F",VNR)=UDT_D_-UA_D_PST_D_KOD_D_UR_D_REF_D_UKC,PST=PST+UA G STF3:'MAXF,STF3:VNR#MAXF
 S U2="",$P(U2,D,6)=$P($T(T11),U,2),^(VNR+1)=U2,^(0)=VNR_D_IND_D_VVK_D_PST_D I VRV D WL
 S STF(9)=VNR+1
STF6 S VRV=0
 Q
 ;
 ;Openstaande orders/toeleveringen
OOT S VNR=0,IND="W"
 N UR,UZ,LC,Typ,Kom,OLUNr,TLUNr
 For  Set IND=$O(^KPR(PR,IND)) Quit:$E(IND,1)'="W"  Do
 .S U2=^(IND),UR=$$TRIMN^vhRtn1($E(IND,18,23)),UZ=$$TRIMN^vhRtn1($E(IND,24,26))+100
 .Quit:'UR  Quit:UZ'>100
 .S (UKC,UKN,Kom,Typ,WK)=""
 .If UR,$E(IND,9)="R" Do  ; Orders
 ..I $D(^KO1(UR,"F")) Do
 ...S UKC=$P(^("F"),D,1),Typ=$P(^KOD(UKC,"F",UR,1),D,25)
 ...S Kom=$P(^KOD(UKC,"F",UR,UZ),D,27)
 ...S:'Kom Kom=$$LOCASE^vhRtn1($P($P(^KOD(UKC,"F",UR,UZ),D,28),";"))
 ...S OLUNr=$P(^KOD(UKC,"F",UR,UZ),D,15)
 ...I $D(^KK1(UKC)) S UKN=$P(^KKL(^(UKC),0),D,2)
 ...S WK=$P(U2,D,2) S:$D(^ORDW("IO",UR,OLUNr)) WK="WMS "
 ..S:WK="" WK="NOK"
 ..S U2=UR_D_UKC_D_UKN_D_WK_D_D_D_$P(U2,D,1)_D_$P("*",D,$P(U2,D,3))_D_Typ_D_D_UZ_D_Kom
 .If $E(IND,9)="T" Do  ; Toelevering
 ..Set LC=$P(^KTO1(UR),D),ABNR=$P(^KTO(LC,UR,1),D,10),LTA=$P(^KTO(LC,UR,UZ),D,29)
 ..S UKC=$P(^KTO(LC,UR,1),D,8),Kom=$P(^KTO(LC,UR,UZ),D,27),TLUNr=$P(^KTO(LC,UR,UZ),D,15)
 ..I UKC,$D(^KK1(UKC)) S UKN=$P(^KKL(^(UKC),0),D,2)
 ..Else  Set UKC="",Kom="stock"
 ..S WK=$P(U2,D,6) S:$D(^RCP("IT",UR,TLUNr)) WK="WMS "
 ..S U2=UR_D_UKC_D_UKN_D_WK_D_$P(U2,D,5)_D_$P("*",D,$P(U2,D,7))_D_D_D_ABNR_D_LTA_D_UZ_D_Kom
 .Set ^HULP($J,"P"_PR,"O",$E(IND,9)_$$INTDATE^vhDTyp(WK,"DW")_UR_UZ)=U2
 Set:$O(^HULP($J,"P"_PR,"O","T"))'=""&($E($O(^("R")))="R") ^("T")=""
OOT4 S WK="",VNR=0
 F  S WK=$O(^HULP($J,"P"_PR,"O",WK)) Q:WK=""  D
 .S U2=^(WK),VNR=VNR+1,^(VNR)=U2 K ^(WK)
 .I $D(SELECT),$P(SELECT,U)="OOT",$P(SELECT,U,2)=$P(U2,D),$P(SELECT,U,3)=$P(U2,D,11) S OOT(6)=VNR K OOT(7),SELECT
OOT6 D WL,O7:'$D(^HULP($J,"P"_PR,"O"))
 Q
 ;
 ;Maandomzet
MOM S (MOM(9),VNR)=0,BP=DJ_"."_$E(100+DM,2,3),FBP=$N(^KSTPR(PR,0,0)) S:FBP=-1 FBP=BP+.01
 S FBP=FBP-.01 S:'(FBP#1) FBP=FBP-1_".12" S FBP=FBP\1_"."_$E(FBP*100,5,6) G MOM2
MOM1 S BP=BP-.01 S:'(BP#1) BP=BP-1_".12" S BP=BP\1_"."_$E(BP*100,5,6)
MOM2 I BP=FBP D WL:VNR'>6,O5:'$D(^HULP($J,"P"_PR,"M")) G MOM3
 S U2="" S:$D(^KSTPR(PR,0,BP_" ")) U2=^(BP_" ") S U2=$P(U2,D,5)_D_($P(U2,D,1)-$P(U2,D,5))_D_$P(U2,D,3)
 S VNR=VNR+1 I VNR=7 D WL
 S ^HULP($J,"P"_PR,"M",VNR)=BP_D_U2 G MOM1
MOM3 S MOM(9)=VNR Q
 ;
 ;Termijnstock
TMS K AX,BX S I=0
TMS1 S I=$N(A(I)) I I'=-1 S AX(I)=A(I) G TMS1
TMS2 S I=$N(B(I)) I I'=-1 S BX(I)=B(I) G TMS2 B
 S PAR(1)=^KPSB(0,1),PAR(2)=^(2),(WVKS,WVKK)="" D ^KPSB2
 K HULP S I=0
TMS3 S I=I+1 G TMS4:I>($P(A(0),D,18)+1) S HULP(I)=$E($P(PAR(2),D,I),1,2)_"/"_$E($P(PAR(2),D,I),3,4)
 G TMS3:'$D(B)
 S HULP(I)=HULP(I)_D_$P(B(5),D,I)_D_$P(B(4),D,I)_D_$P(B(3),D,I)_D_$S($L($P(B(1),D,I)):$E($P(B(1),D,I),1),1:$S(I=1:"",1:"-"))
 S HULP(I)=HULP(I)_D_$P(B(2),D,I)_D_$P("*",D,$P(B(7),D,I))_D_$P("*",D,$P(B(6),D,I)) G TMS3
TMS4 K A,B S I=0
TMS5 S I=$N(AX(I)) I I'=-1 S A(I)=AX(I) G TMS5
TMS6 S I=$N(BX(I)) I I'=-1 S B(I)=BX(I) G TMS6
 K AX,BX,PAR
 D WL
 Q
 ;
 ;Detail maandomzet
DEM S (DEM(9),VNR,UKC)=0
DEM1 S UKC=$N(^KSTPR(PR,UKC)) I UKC=-1 D WL:VNR'>10,O6:'$D(^HULP($J,"P"_PR,"M",BP)) G DEM2
 G DEM1:'$D(^(UKC,BP_" ")) S U2=^(BP_" ") G DEM1:'$D(^KK1(UKC)) S UKN=$P(^KKL(^(UKC),0),D,2)
 S U2=$P(U2,D,5)_D_($P(U2,D,1)-$P(U2,D,5))_D_$P(U2,D,3)
 S VNR=VNR+1 I VNR=11 D WL
 S ^HULP($J,"P"_PR,"M",BP,VNR)=UKC_D_UKN_D_U2 G DEM1
DEM2 S DEM(9)=VNR Q
 ;
 ; Pakketten / Klantreferenties
PRF New PAKNr,Pak,KLNr,KLId,KLNrr,KLNm,Nm,Rec,Cnt
 Set (KLNr,PAKNr)=""
PRF1 For  Set KLNr=$O(^PAKKET("IP",PR,KLNr)) Quit:KLNr=""  Do
 .For  Set PAKNr=$O(^PAKKET("IP",PR,KLNr,PAKNr)) Quit:PAKNr=""  Do
 ..Set Pak=^PAKKET("D",PAKNr)
 ..If KLNr=0 Set KLId="~",KLNrr="",KLNm="N.V. eigen"
 ..Else  Set KLId=$G(^KK1(KLNr)),KLNrr=KLNr Set:$L(KLId) KLNm=$P(^KKL(KLId,0),D,2)
 ..Quit:KLId=""
 ..Set Rec=PAKNr_D_KLNr_D_KLNrr_D_KLNm_D_$P(Pak,D,2)_$S($L($P(Pak,D,4)):" : "_$P(Pak,D,4),1:"")_D_$P(Pak,D,3)_D_^PAKKET("D",PAKNr,PR)
 ..Set ^HULP($J,"P"_PR,"R",KLId_" "_$$UPTRIMAN^vhRtn1(Pak))=Rec
 Set Nm="",Cnt=0,KLNr=""
 For  Set Nm=$O(^HULP($J,"P"_PR,"R",Nm)) Quit:Nm=""  Do
 .Set Rec=^(Nm)
 .If $P(Rec,D,2)=KLNr Set $P(Rec,D,3,4)=D
 .Else  Set KLNr=$P(Rec,D,2) Set:Cnt Cnt=Cnt+1,^(Cnt)=""
 .Set Cnt=Cnt+1
 .Set ^(Cnt)=Rec
 .Kill ^(Nm)
 Set PRF(9)=Cnt
PRF2 D WL^PROC,O10:'$D(^HULP($J,"P"_PR,"R"))
 Q
 ;
YZ Q
 Q
Z X ^cZ Q
ZZ ; 14.06.91 -  9 u 17