KP49 G 1 ;STOCKWIJZIGINGEN ; [ 10/25/2002  11:25 AM ]
 ;
T1 ;REFERENTIE
T2 ;[] = 
T3 ;GEEF HET ;STOCK;CORRECTIE; AANTAL
T4 ;;aantal[] = in   of   aantal-[] = uit   ;([] = vorig   )[] = volgend
T5 ;INGAVE VIA DE NIEUWE FYS STOCK, CORRECTIE OF OVERDRACHT
T6 ;S[] = Aantal in stock   C[] = Correctie (verschil)   O[] = Overdracht
T8 ;[] = REGISTRATIE OK   ,[] = HERNEMEN
T9 ;IDENTNUMMER     
T10 ;PRODUCTNAAM     
T11 ;OMSCHRIJVING NL 
T12 ;PLAATS MAGAZIJN 
T13 ;CIFFPPL
T14 ;LIJSTPRIJS
T16 ;OUDE FYS STOCK
T18 ;CORRECT. AANT.
T20 ;NIEUWE FYS STOCK
T21 ;OVERDRACHT NAAR
 ;
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
 ;
S7 ;S S4=$P(R,D,2)+1+F60,S0=0,SA=$P(R,D,3),S8="^"_Q_$P(R,D,4),S9="^"_Q_$P(R,D,5),FP=S4 W @F,@F1
S7A ;S FP=2403+F60 W @F,@F1,SA W:$D(PR) "  ([] vorig  )[] volgend" W " : ",@F0
S7B ;R K 
 ;I $D(PR),$L(K)=1,"()"[K G S7Z
 ;S K=$$SELECT^PRODUKT6("","",K)
 S K=$$SELECT^PRODUKT6()
 S:K="." K="-"
 I K'="-" S PR=K
S7Z K S0,S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,SA,ST Q
 ;
S2 S @S=$$ROUND^KPRIJS(@S) Q
 ;
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
 N IsEuro
 S IsEuro=$$ISEURO^vhRtn1()
3 S R="ASC\21\3\"_$P($T(T5),U,2)_"\"""_$P($T(T6),U,2)_"""\1\\""-SCO""[K&$L(K)" D R0 G YZ:K="-"
7 S DAI=$E(DJ,1,2)_$P(DT,".",3)_$P(DT,".",2)_$P(DT,".",1),FP=402 W @F,@F1 D 100
10 S K="Overdracht"
 I ASC'="O" S R="K\21\3\"_$P($T(T1),U,2)_"\""" S:$D(UIN) R=R_$P($T(T2),U,2)_UIN S R=R_"""\10\\'$D(UIN)&$L(K)!$D(UIN)" D R0 G YZ:K="-"
 I K'="" S UIN=K,FP=1622 W @F,@F2,K
 ;
11 L  S R="PR\1900\PRODUCTNAAM\PR\PR1"
12 D S7 I K=")"!(K="(") S K=$$NEXT^PRODUKT("K",PR,$S(K="(":-1,1:1)) S:$L(K) PR=K G 14
 G:K="-" YZ:ASC="O",10 S FP=1901 W @F,@F1 S Q0="^"_Q_"PR(PR)",Q1="^"_Q_"PR(PR,0)"
14 I '$D(@Q0) X ^cTXT(0,"N",88) R K G 11
16 L @Q0:2 E  X ^cTXT(0,"N",108) H 3 G 11
18 S B0=@Q1,B1="\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\",STK=$P(B0,D,14),PNR=$P(^(2),D,25)
180 S J=$N(^("J"))
182 S B1=^(J),PV=$P(B1,D,25),PA=$P(B1,D,23) F S="PA","PV" D S2
19 S FP=422 W @F,@F2,PNR S FP=522 W @F,@F2,$P(B0,D,1) S FP=622 W @F,@F2,$P(B0,D,2) S FP=722 W @F,@F2,$P(B0,D,6) S FP=922 W @F,@F2,PA S FP=1022 W @F,@F2,PV
190 S FP=1222 W @F,@F2,+STK F FP=1322:100:1422 W @F,@F2
 S PV=$J($P(B1,D,25),0,$S(IsEuro:4,1:2)),PA=$J($P(B1,D,23),0,$S(IsEuro:4,1:2))
24 S R="ATLX\22\3\"_$P($T(T3),U,2)_$P($T(T3),U,"OC"[ASC+3)_$P($T(T3),U,5)
 S R=R_"\"""_$P($T(T4),U,"OC"[ASC+2)_$P($T(T4),U,4)
 S R=R_"""\6\\K?.N!(K?1.N1""-""&(""OC""[ASC))!(K?1""-""1.N&(""OC""[ASC))&K!(K=0&(ASC=""S""))!(""()-""[K&($L(K)=1))\" D R0
 I "()"[K S K=$$NEXT^PRODUKT("K",PR,$S(K="(":-1,1:1)) S:$L(K) PR=K G 14
 I K="-" D  G 11
 .F FP=422:100:722,922,1022,1522 W @F,@F2
 S:ATLX["-" ATLX=-$$UPTRIMAN^vhRtn1(ATLX)
 I ASC="O",ATLX>0 S K=$$ASK^vhINP("Aantal is groter dan nul, toch toelaten? ",1,"","Bij overdracht wordt een aantal verwacht kleiner dan nul","J[] = Toelaten") Set FP=2101 Write @F,@F1 G 24:K'="J"
 I ASC="S" S ATLX=ATLX-STK
 S FP=1322 W @F,@F2,ATLX S FP=1422 W @F,@F2,STK+ATLX
 Set VanPR=PR
 ; Overdracht naar
 If ASC="O" Do  Goto 11:NaarPR=".",24:NaarPR="-"
 .New IdentNr
 .Set IdentNr=$P(^KPR(PR,2),D,25)
 .If $E(IdentNr)>0,$E(IdentNr)<8 Set $E(IdentNr)=0
 .Else  Set $E(IdentNr)=1
 .Set:'$D(^KPR2($$TRIMIDENT^vhRtn1(IdentNr)_" ")) IdentNr="" ;[IDENT] CW
25 .Set NaarPR=$$SELECT^PRODUKT6("","",IdentNr_"*","Overdracht naar product : ")
 .Set FP=sRT*100+1 Write @F,@F1
 .Quit:'NaarPR
 .Goto 25:NaarPR=VanPR
 .Set FP=1822 Write @F,@F2,$P(^KPR(NaarPR,2),D,25) 
 .Set FP=1922 Write @F,@F2,$P(^KPR(NaarPR,0),D)
 .Set PR=NaarPR
 .L +@Q0:2 E  X ^cTXT(0,"N",108) H 3 G 25
 Set PR=VanPR
 
28 S R="K\22\3\"_$P($T(T8),U,2)_"\\1\\"",-""[K\\" D R0 I K="-" S FP=1322 W @F,@F2 S FP=1422 W @F,@F2 G 24
29 I K="," F FP=422:100:722,922,1022,1222:100:1922 W @F,@F2
30 G 11:K=","
 Set:ASC="O" UIN="Ovdr "_NaarPR
 Do STORE
 If ASC="O" Set ATLX=-ATLX,PR=NaarPR,UIN="Ovdr "_VanPR Do STORE
 G 11:$E(UIN,1,3)="INV",10
 ;
YZ Q
 
STORE 
 I ATLX>0 D
 .S R=DAI_3_D_ATLX_D_PA_D_1_D_PV_D_D_D_UIN_D_D_D
 .D ^KPR20,PUT^PRHIST(PR,ATLX,$S(ASC="O":"T",1:"M"),,,,,,,UIN)
 E  D
 .S R=DAI_4_D_(-ATLX)_D_D_1_D_(PA*ATLX)_D_D_D_UIN_D_D_D_DT_D
 .D ^KPR10,PUT^PRHIST(PR,ATLX,$S(ASC="O":"T",1:"M"),,,,,,,UIN)
 Q
 ;
100 F FP=419,519,619,719,910,1013,1217,1317,1419,1613 W @F,@F5
101 S FP=402 W @F,@F4,$P($T(T9),U,2),@F5,":"
102 W !,?1,@F4,$P($T(T10),U,2),@F5,":"
103 W !,?1,@F4,$P($T(T11),U,2),@F5,":"
104 W !,?1,@F4,$P($T(T12),U,2),@F5,":"
105 W !!,?1,@F6,$P($T(T13),U,2),@F9,?24,":"
106 W !,?1,@F6,$P($T(T14),U,2),@F9,?24,":"
107 W !!,?1,@F6,$P($T(T16),U,2),@F9,?24,":"
108 W !,?1,@F92,$P($T(T18),U,2),@F93,?24,":"
109 W !,?1,@F6,$P($T(T20),U,2),@F9,?24,":"
111 W !!,?1,@F6,$P($T(T1),U,2),@F9,?24,":"
110 W:$G(ASC)="O" !!,?1,@F6,$P($T(T21),U,2),@F9,?24,":"
199 Q
 ;