KPSTV3 G 1 ;VERSCHILLIJST STOCKWAARDE ;(VOLGENS KLASS.);KPSTV1;Go van KPSTV1 - Do naar KPSELS [ 06/29/2003  4:49 PM ]
 ;
T1 ;SELEKTIE : 
T2 ;": IDENTNUMMER : PRODUKTNAAM               :  VOR. FS : HUID. FS : VERSC FS :"_$J("WAARDE "_FAMNT,10)_" :"
T3 ;:-------------:---------------------------:----------:----------:----------:-----------:
T4 ;BLZ:
T5 ;TOTAAL VOOR : 
T11 ;Output : .
T12 ;P = Printer  T = Transfert
T13 ;Saving ...
T14 ;Save complete.
T15 ;[] = ok
 ;
R3 S R1=$P(R,D,2),R2=$P(R,D,4),R0=$J($P(R,D,1),0,R2),R3=" ",R4="" S:R2 R4=","_$P(R0,".",2),R1=R1-1-R2 S:R0<0 R3="-",R0=-R0
R3A S R0=+$P(R0,".",1) F R5=3,7 S R6=$L(R0) G R3B:R6'>R5 S R0=$E(R0,1,R6-R5)_"."_$E(R0,R6-R5+1,R6)
R3B W ?$P(R,D,3),$J(R0,R1),R4,R3
R3Z K R0,R1,R2,R3,R4,R5,R6 Q  ;V1 26.11.84
 ;
1 S FP=2301 W @F,@F1,"  ",$P($T(T11),U,2),!?2,$P($T(T12),U,2)
 K IK D IK^PROC1
 S Output=R,FP=2301 W @F,@F1
 G YZ:R="-" I R'="T",R'="P" G 1
 I Output="P" S BLZ=0 D INIT^vhPRINTER("S;L;B",90) G YZ:'$D(Print) S I=100 G 19:$N(B(I))=-1 D HD,^KPSELS
 I Output="T" D  G YZ:$G(Quit)
 .S File=$$ASKFILE^vhDEV("TRANS.TXT")
 .I "-."[File S Quit=1 Q
 .S Dev=$$OPEN^vhDEV($$DIRUSER^vhDEV,File,"W")
 .I 0[Dev S Quit=1 Q
 .Use 0
 .Set FP=2003 Write @F,@F2,$P($T(T13),U,2)
 .U Dev
19 S FAMNT=$$MUNT^vhRtn1(,1),FAMNTRND=$$MUNT^vhRtn1(,4)
 D HD:Output="T"
 S Q0="^"_Q_"PR(PR,0)",Q1="^"_Q_"PH(HG)",Q2="^"_Q_"PH(HG,GRS)",Q3="^"_Q_"PH(HG,GRS,SGS)",Q4="^"_Q_"PH(HG,GRS,SGS,MK,PRCS)"
21 S (ATPWA,ATVPWA,ATHPWA)=0 F I="HG","GR","SG" S @("EX"_$E(I,1))=$P(@("^"_Q_"PR(0,I)"),D,5)
23 I HG'=0 S X=$D(@Q1) G 27:X
25 S HG=$N(@Q1) I HG=-1!(HG]HGX) G 160
27 D HD:Output="P" S (TPWA,TVPWA,THPWA)=0,GRS=GR I GR'=0 S X=$D(@Q2) G 31:X
29 S GRS=$N(@Q2) I GRS=-1!(GRS]GRX) D  G 25
 .Quit:Output'="P"
 .W !,$P($T(T3),U,2),!!?2,$P($T(T5),U,2),$E(HG,EXH,99)
 .W:GR=GRX "- ",$E(GR,EXG,99) W:SG=SGX "- ",$E(SG,EXS,99)
 .S R=TVPWA_"\10\42\0" D:+R R3 S R=THPWA_"\10\53\0" D:+R R3
 .S R=TPWA_"\12\74\"_FAMNTRND D:+R R3 W #
31 S SGS=SG I SG'=0 S X=$D(@Q3) G 35:X
33 S SGS=$N(@Q3) I SGS=-1!(SGS]SGX) G 29
35 S PRCS=PRC I PRC'=0 S X=$D(@Q4) G 100:X
37 S PRCS=$N(@Q4) I PRCS=-1!(PRCS]PRCX) G 33
100 S PR=+^(PRCS)
 G 37:$P(^KPR(PR,1),D,25) ; NON-Aktief
 G 37:$D(^PRLINK("D",PR)) ; Moederprodukt
 D ^KPCHKPR G 37:'OK
 S PC=$P(A(0),D,1),PST=$P(A(0),D,14),PSTO=$P($G(^PRSTOCK("D",PR)),D,7)
 S WVST=$P($G(^PRSTOCK("D",PR)),D,5),WVSTO=$P($G(^PRSTOCK("D",PR)),D,8)
 S PCA=$P(A(1),D,25),PID=$P(A(2),D,25)
 ;S PPL=$P(A("J"),D,19),PMA=$P(A("J"),D,17),PK1=$P(A("J"),D,9),PK2="",PEA=$P(A("J"),D,28) K A
 ;S:PEA="H" PPL=PPL/100 S:PEA="M" PPL=PPL/1000 S PPAR=1 S:$L(PMA) PPAR=$$MUNT^vhRtn1(PMA,,11)
 ;S PPL=$J(PPL*PPAR*(100-PK1)/100*(100-PK2)/100,0,2)
 S R=$$PROD^KPRIJS(PR,"","",""),CPPL=$P(R,D,13)
 ;S HPWA=PPL*PST,VPWA=PPL*PSTO
 ;S HWVWA=PPL*WVST,VWVWA=PPL*WVSTO
 S HPWA=CPPL*PST,VPWA=CPPL*PSTO
 S HWVWA=CPPL*WVST,VWVWA=CPPL*WVSTO
 S:'FAMNTRND HPWA=HPWA+.99999\1,VPWA=VPWA+.99999\1 S PWA=HPWA-VPWA
 S ATVPWA=ATVPWA+VPWA,TVPWA=TVPWA+VPWA
 S ATHPWA=ATHPWA+HPWA,THPWA=THPWA+HPWA
 I Output="P" G 37:+PST=+PSTO
 I Output="T",+PST=+PSTO,+WVST=+WVSTO G 37
 S ATPWA=ATPWA+PWA,TPWA=TPWA+PWA
122 I Output="P" S LN=LN+1 I LN>50 W !,$P($T(T3),U,2),# D HD G 122
 D:Output="P"
 .W !,": ",PID,?14,": ",PC W:PCA ?41,"#" W ?42,":" S R=PSTO_"\9\43\0" D:+R R3 W ?53,":"
 .S R=PST_"\9\54\0" D:+R R3 W ?64,":" S R=(PST-PSTO)_"\9\65\0" D:+R R3 W ?75,":" S R=PWA_"\10\74\"_FAMNTRND D:+R R3 W ?87,":"
 D:Output="T"
 .I PST'=PSTO W PID,$C(9),PC,$C(9),"M",$C(9),PSTO,$C(9),PST,$C(9),$J(VPWA,0,FAMNTRND),$C(9),$J(HPWA,0,FAMNTRND),! ;,$C(13)
 .I WVST'=WVSTO W PID,$C(9),PC,$C(9),"W",$C(9),$TR($J(WVSTO,0,2),".",","),$C(9),$TR($J(WVST,0,2),".",","),$C(9),$TR($J(VWVWA,0,FAMNTRND),".",","),$C(9),$TR($J(HWVWA,0,FAMNTRND),".",","),! ;,$C(13)
 G 37
160 G 164:Output'="P" D HD W !!?2,"ALGEMEEN TOTAAL"
 S R=ATVPWA_"\10\42\0" D:+R R3 S R=ATHPWA_"\10\53\0" D:+R R3 S R=ATPWA_"\12\74\"_FAMNTRND D:+R R3
164 I Output="P" W # D CLOSE^vhPRINTER
 I Output="T" D
 .U 0
 .S FP=2301 W @F,@F1 S FP=2303 W @F,$P($T(T14),U,2),!?2,$P($T(T15),U,2)
 .D IK^PROC1
 .C Dev
YZ Q
 ;
HD I Output="T" D  Q
 .W "Identnummer",$C(9),"Korttekst",$C(9),"Type",$C(9),"Oude stock",$C(9)
 .W "Nieuwe stock",$C(9),"Oude waarde "_FAMNT,$C(9),"Nieuwe waarde "_FAMNT,! ;$C(13)
 S BLZ=BLZ+1,LN=0 W !,QN,?80,$P($T(T4),U,2),$J(BLZ,4),!,NM2,?30,$P($T(+1),U,2),?53,$P($T(+1),U,3),?80,DT,!,NM3
HDA W ?30,$P($T(T1),U,2),X1,"   ",X2,?81,TD,!! I HG=-1!(HG]HGX) G HDZ
HDB I BLZ>1!($N(B(100))=-1) W $E(HG,EXH,99) W:GR=GRX "- ",$E(GR,EXG,99) W:SG=SGX "- ",$E(SG,EXS,99) W !!,$P($T(T3),U,2),!,@$P($T(T2),U,2),!,$P($T(T3),U,2)
HDZ Q
 ;