KPRLK1 G 1 ;PRIJSLIJST KLANTEN ;KPRLK1; Go naar KPRLK2 [ 08/06/2002   8:52 AM ]
 ;
T1 ;AFDRUK IN NLQ;1;1;IN NLQ
T2 ;AFDRUK MET SUBGROEPSCHEIDING;2;1;MET SUBGROEPSCHEIDING
T3 ;MET VERPAKKING;6;1;MET VERPAKKING
T4 ;HUIDIGE PRIJZEN;3;$G(^KLPUTZ("AS"));HUIDIGE PRIJZEN
T5 ;SCHADUW PRIJZEN;4;$G(^KLPUTZ("AS"));SCHADUW PRIJZEN
T6 ;MET PERCENTAGE;5;$G(^KLPUTZ("AS"));PERCENTAGE
 ;
T13 ;VANAF DATUM :
T14 ;TOT DATUM   :
T15 ;EERSTE AF TE DRUKKEN PERIODE
T16 ;LAATSTE AF TE DRUKKEN PERIODE
T17 ;BEPERKING KLASSIFIKATIE
T18 ;SC1
T19 ;[] = geen  H[] = hoofdgroep  G[] = groep  S[] = subgroep  D[] = geen deuren
T20 ;A[] = geen afgeleide produkten
T21 ;GEEN;HOOFDGROEP;GROEP;SUBGROEP;GEEN DEUREN;GEEN AFGELEIDE PRODUKTEN
T22 ;SC3
T23 ;SC4
T24 ;.[] = vanaf het begin   onder de vorm jjjj.mm
T25 ;I[] =idem als vorige   .[] = tot het einde   onder de vorm jjjj.mm
T26 ;AFDRUKKEN MET OF ZONDER PRIJSVERGELIJK
T27 ;M[] = met   Z[] = zonder
T28 ;AFDRUKKEN MET OF ZONDER PERCENTAGE    
T29 ;PRIJZEN PRIJSLIJST                    
T30 ;[] = schaduw   1[] = huidige
T31 ;KLANTEN MET TOTALE OMZET TUSSEN        :
T32 ; EN 
T33 ;TOTALE OMZET BINNEN DE GESELEKTEERDE PERIODE VANAF
T34 ;TOTALE OMZET BINNEN DE GESELEKTEERDE PERIODE TOT
T36 ;.[] = vanaf 0
T37 ;.[] = tot oneindig
T38 ;ONEINDIG
 ;
 ;    initialisatie + vraag
1 S K=$P($T(+1),U,2)_QN_" ",FP=203+$L(K) W @F61,@F11,@F1,@F,@F5 S FP=202 W @F,@F4,K,@F5
2 I '$G(^KLPUTZ("AS")) S FP=2403+F60 W @F,@F4,"OPGELET ! DE SCHADUWUITZONDERINGEN ZIJN NIET AKTIEF  [] = ok ",@F5,@F0 R K
3 S NVG=0,KSEL=1 D KP^KSEL G YZ:K="-"
5 S Q1="^"_Q_"KL(^"_Q_"K1(KC),0)",Q2="^"_Q_"STKL(KC)",Q3="^"_Q_"STKL(KC,PR)",Q4="^"_Q_"STKL(KC,PR,BP)",Q5="^"_Q_"PR(PR,0)"
7 S FP=1403 W @F,$P($T(T13),U,2),!!?2,$P($T(T14),U,2)
41 S R="K\23\3\"_$P($T(T15),U,2)_"\"_$P($T(T22),U,2)_"\7\\"".-""[K&$L(K)!(K?4N1"".""2N&($P(K,""."",2)<13))" D R0 G 3:K="-"
45 I K="." S FBP=@("^"_Q_"STKL(0,0,1)"),HFBP="01."_$P(FBP,".",2)_"."_$E($P(FBP,".",1),3,4)_D_1,FP=1417 W @F,$P(HFBP,D,1),@F2 G 49
47 G 41:K<@("^"_Q_"STKL(0,0,1)") S FBP=K,HFBP="01."_$P(K,".",2)_"."_$E($P(K,".",1),3,4),FP=1417 W @F,HFBP,@F2
49 S FP=1901 W @F,@F1
51 S R="K\23\3\"_$P($T(T16),U,2)_"\"_$P($T(T23),U,2)_"\7\\"".-I""[K&($L(K)=1)!(K?4N1"".""2N&($P(K,""."",2)<13))" D R0 G 41:K="-"
53 I K="." S LBP=$$EXTDATE^vhDTyp(,"DM4"),HLBP=DT_D_1,FP=1617 W @F,$P(HLBP,D,1) G 57
55 S:K="I" K=FBP G 49:FBP]K S LBP=K
 S HLBP=$$EXTDATE^vhDTyp($$CALCDATE^vhDTyp($$INTDATE^vhDTyp($$CONVDATE^vhDTyp(K,"DM","DK")),"M","LD"),"DKP")
56 S:$E(LBP,3,4)'<$P(DT,".",3)&($P(LBP,".",2)=$P(DT,".",2)) HLBP=DT S FP=1617 W @F,HLBP,@F2
57 D BEPERK G 49:K="-"
570 S KPUPS=$G(^KLPUTZ("AS"))
 D INST G 57:$P(Prefs,D,3,4)=D D DISPLAY G 62
 I 'KPUPS S (ZMPV,ZMPC)="Z",KHS=1 G 62
572 S R="KHS\19\3\"_$P($T(T29),U,2)_"\"""_$P($T(T30),U,2)_"""\1\\""-1""[K" D R0 G 57:K="-"
574 S KPUPS=1-K S FP=1944 W @F,@F1,$P("SCHADUW\HUIDIGE",D,K+1) I 'KPUPS S (ZMPV,ZMPC)="Z" G 62
58 S R="ZMPV\20\3\"_$P($T(T26),U,2)_"\"""_$P($T(T27),U,2)_"""\1\\""-MZ""[K&$L(K)" D R0 G 57:K="-"
59 S FP=2044 W @F,@F1,$S(K="M":"MET",1:"ZONDER")," PRIJSVERGELIJK"
60 S ZMPC="Z" G 62:K="Z" S R="ZMPC\21\3\"_$P($T(T28),U,2)_"\"""_$P($T(T27),U,2)_"""\1\\""-MZ""[K&$L(K)" D R0 G 58:K="-"
61 S FP=2144 W @F,@F1,$S(K="M":"MET",1:"ZONDER")," PERCENTAGE"
62 S OOG=0,OBG=1000000000 G 64:Q0'=("^"_Q_"KL(KL)") S FP=2203+F60 W @F,@F1,$P($T(T31),U,2)
620 S R="OOG\23\3\"_$P($T(T33),U,2)_"\"""_$$MUNT^vhRtn1(,1)_$P($T(T36),U,2)_"""\8\\K?.N&K!(""-.""[K&($L(K)=1))" D R0
622 I K="-" G 57:'$G(^KLPUTZ("AS")),570 ;:'KPUPS,60:ZMPV="M",58
624 S:K="." OOG=0 S FP=2244+F60 W @F,OOG,$P($T(T32),U,2)
626 S R="OBG\23\3\"_$P($T(T34),U,2)_"\"""_$$MUNT^vhRtn1(,1)_$P($T(T37),U,2)_"""\8\\K?.N&K!(""-.""[K&($L(K)=1))" D R0
628 I K="-" S FP=2244+F60 W @F,@F2 G 620
629 S:K="." OBG=1000000000 G 626:OBG<OOG S FP=2248+$L(OOG) W @F,$S(OBG>99999999:$P($T(T38),U,2),1:OBG)
64 S NLQ=$P(Prefs,D),PrintSGr=$P(Prefs,D,2),KHS='$P(Prefs,D,4)
65 S ZMPV=$P(Prefs,D,3)&($P(Prefs,D,4)),ZMPC=$P(Prefs,D,5),VERP=$P(Prefs,D,6),FBP=FBP_" ",LBP=LBP_" "
66 S SW37=0 S:$D(@("^"_Q_"BA(37)")) SW37=^(37) I 'SW37 F I=1:1:12 I $D(@("^"_Q_"BA(99,I)")) S @(Q_"BA(99,I)")=^(I)
67 I NVG S KLX=NVG
69 G ^KPRLK2
 ;
YZ K @("^"_Q_"SEL($J)") Q
 ;
BEPERK 
 N BST,SEL,LGT,SELECTED
B1 K BEPERK
 S R="K\18\3\"_$P($T(T17),U,2)_"\"_$P($T(T18),U,2)_"\1\\""HGSDA-""[K" D R0
 I K="-" S FP=1803 W @F,@F1 Q
 S NoDoors=K="D",NoGenPr=K="A",FP=1829 W @F,@F1,$P($T(T21),U,$F("HGSDA",K)+1) I "AD"[K Q
 S BEPERK=K,SELECTED="("
 S R=$P("HG\GR\SG\MK",D,$F("HGS",K)-1),BST="P"_R,R=^KPR(0,R),SEL=$P(R,D,2),LGT=$P(R,D,1)
B2 S R="2000\"_SEL_D_BST D S7^SUBROUT G B1:K="-"
 I K'="." D  G B2
 .S R=$P(@("^"_Q_BST_"(R)"),D,2)
 .Q:$D(BEPERK(R))
 .S BEPERK(R)=""
 .I SELECTED'="(" S SELECTED=SELECTED_", "
 .S SELECTED=SELECTED_$$DISPLS^KLASS(R)
 .S FP=1829+$L($P($T(T21),U,$F("HGS",BEPERK)+1))
 .I $L(SELECTED)+FP>1877 S SELECTED="(..., "_$P(SELECTED,", ",SELECTED["..."+2,99)
 .W @F,SELECTED,@F2
 I $D(BEPERK)=1 K BEPERK S FP=1829 W @F,@F1,$P($T(T21),U,2) Q
 S SELECTED=SELECTED_")",FP=1829+$L($P($T(T21),U,$F("HGS",BEPERK)+1))
 I $L(SELECTED)+FP>1877 S SELECTED="(..., "_$P(SELECTED,", ",SELECTED["..."+2,99)
 W @F,SELECTED,@F2
 Q
 ;
INST New Y,I,R,T
 Set X=U,T=0 Set Prefs=$G(Prefs),$P(Prefs,D,6)=1 If $P(Prefs,D,3)="",$P(Prefs,D,4)="" Set $P(Prefs,D,3,4)="1\"
 For I=1:1 Set R=$T(@("T"_I)) Quit:R=""  Do
 .If @$P(R,U,4) Set T=T+1,Y(T)=$P(R,U,2),K=$P(R,U,3),K=$P(Prefs,D,K) If K Set X=X_T_U
 Set X=$E(X,2,$L(X)-1),Y="20\M\INSTELLINGEN\CB^KPRLK1",Y(0)=T
 Do ^POP
 Set X=U_X_U
 For I=1:1 Set R=$T(@("T"_I)) Quit:R=""  Do
 .Set R=$P(R,U,3)
 .Set K=U_I_U,K=X[K If 'K Set K=""
 .Set $P(Prefs,D,R)=K
 If '$G(^KLPUTZ("AS")) Set $P(Prefs,D,3)=1
 Quit
 ;
CB 
 New K,I
 Set R=$T(@("T"_sLD(6))) Quit:R=""
 If $P(R,U,3)=3,(U_X_U)[";6;",'$L($P(Y(4),D,99)) Set $P(Y(6),D,99)="" Do WL^PROC Quit
 If $P(R,U,3)=3,(U_X_U)[";3;",(U_X_U)[";5;" Set $P(Y(sLD(6)),D,99)="" Do EL^PROC
 If $P(R,U,3)=4,(U_X_U)[";6;",'$L($P(Y(5),D,99)) Set $P(Y(6),D,99)="" Do WL^PROC Quit
 If $P(R,U,3)=4,(U_X_U)[";3;",(U_X_U)[";4;" Set $P(Y(sLD(6)),D,99)="" Do EL^PROC
 If $P(R,U,3)=5 Do
 .If (U_X_U)[";4;",(U_X_U)[";5;" Quit
 .Set $P(Y(sLD(6)),D,99)="" Do EL^PROC
 If $P(R,U,3)=6,(U_X_U)[";4;",(U_X_U)[";5;" Set $P(Y(sLD(6)),D,99)="" Do EL^PROC
 Quit
 ;
DISPLAY 
 New T
 Set T=0,FP=1901 Write @F,@F1,$C(13)
 If '$G(^KLPUTZ("AS")),'$P(Prefs,D),'$P(Prefs,D,2),'$P(Prefs,D,4),'$P(Prefs,D,5) Quit
 Write ?2,"AFDRUK",?26,": "
 If $G(^KLPUTZ("AS")) Do
 .If $P(Prefs,D,3) Write $P($T(T4),U,5) Set T=T+1
 .If $P(Prefs,D,4) Write:T " + " Write $P($T(T5),U,5) Set T=T+1
 .If $P(Prefs,D,5) Write:T " + " Write $P($T(T6),U,5) Set T=T+1
 .Set T=0
 .Write !?28
 If $P(Prefs,D,1) Write $P($T(T1),U,5) Set T=T+1
 If $P(Prefs,D,2) Write:T ", " Write $P($T(T2),U,5) Set T=T+1
 If $P(Prefs,D,6) Write:T ", " Write $P($T(T3),U,5) Set T=T+1
 Quit
 ;
SC1 W !?2,$P($T(T19),U,2),!?1,$P($T(T20),U,2) Q
SC3 W !?2,$P($T(T24),U,2) Q
SC4 W !?2,$P($T(T25),U,2) Q
 ;
R0 S R7="K'[D&(K'?.E1C.E)" S:$P(R,D,8)'="" R7=R7_"&("_$P(R,D,8)_")" S:$P(R,D,7)'="" R7=R7_"&("_$P($T(@$P(R,D,7))," ",2,99)_")"
R0A S R2=$P(R,D,2),R3=$P(R,D,3),R4=$P(R,D,4),R5=$P(R,D,5),R6=$P(R,D,6)
R0B S R0=$L(R4)+R3+3 S FP=R2*100+R3+F60 W @F W:R3<4 @F1 W @F2,R4," : " I R5'="" W:R5["""" !,?2,@R5 D:R5'["""" @R5
R0C S FP=R2*100+R0+F60 W @F,@F2 W $E("........................................",1,R6),@F,@F0
R0D R K W @F2 I $L(K)'>R6,@R7 S @$P(R,D,1)=K
R0E E  G R0C
R0F S FP=$P(R,D,9)*100+($P(R,D,10)*1) I FP W @F,$J("",R6),@F,K
R0Z K R,R0,R2,R3,R4,R5,R6,R7 Q  ;V4 03.10.84
 ;