cPE78 G 1 ;VERWIJDEREN HISTORIEKEN ;%PE78; OVERLAY NAAR %PE81 [ 03/07/2002  9:19 AM ]
 ;
T1 ;PRODUKTNUMMER   
T2 ;OMSCHRIJVING    
T3 ;LIGGING         
T4 ;HET PRODUKT IS VERVANGEN DOOR PRODUKT 
T5 ;ONBEKEND PRODUKT 
T6 ;VERWIJDEREN HISTORIEKEN
T7 ;"V[] = verwijderen   ,[] = hernemen"
T8 ;EINDDATUM
T9 ;"[] = verwijderen alle historieken   dd.mm.jj[] = einddatum"
T10 ;"V[] = definitief verwijderen   ,[] = hernemen"
T11 ;ALLE HISTORIEKEN
 ;
ER G ^II:$ZE["<INTERRUPT>",^cER
 ;
R0 S R7=1 S:$P(R,D,8)'="" R7=R7_"&("_$P(R,D,8)_")" S:$P(R,D,7)'="" R7=R7_"&("_$P($T(@$P(R,D,7)),U,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,$E("........................................",1,R6),@F,@F0
R0D R K W @F2 I $L(K)'>R6,K'[D&(K'?.E1C.E),@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  ;V5 02.01.86
 ;
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
10 S Y=$N(@("^"_Q_"PR(0,"" "")")),Y=" ",SWP=1
12 S Y=$N(^(Y)) G 14:Y=-1 S @Y=^(Y) G 12
14 S Y=99
16 S Y=$N(^(Y)) G 18:Y=-1!(Y>999) G 16:$P(^(Y),U,16)'=106 S C(106)=^(Y)
18 I '$D(C(106)) S C(106)=""
2 S R="DAT\22\3\"_$P($T(T8),U,2)_D_$P($T(T9),U,2)_"\8\DCTR\" D R0 G YZ:K="-" I K="" S FP=279-$L($P($T(T11),U,2)),DAT=DT W @F,$P($T(T11),U,2),@F2 G 3
20 S DAT1=$E(K,7,8)_$E(K,4,5)_$E(K,1,2) S FP=276-$L(DAT)-$L($P($T(T8),U,2)) W @F,$P($T(T8),U,2)," : ",K,@F2
 ;
3 S FP=301 W @F,@F1 D ^cPE123 G YZ:K="-"
4 S R="K\23\3\"_$P($T(T6),U,2)_D_$P($T(T7),U,2)_"\1\\"",-V""[K&$L(K)\" D R0 G 3:K="-"!(K=",") S FP=301 W @F,@F1 D 100
5 S R="K\22\3\"_$P($T(T6),U,2)_D_$P($T(T10),U,2)_"\1\\"",V""[K&$L(K)\" D R0 G 2:K=","
7 S Q0="^"_Q_"PR(PR)",Q1="^"_Q_"PR(PR,0)"
 ;
24 D ^cPE124 G YZ:PR=-1
 ;
31 I '$D(@Q0) S FP=2403+F60 W @F,@F4,$P($T(T5),U,2),@F5,@F2 H 3 G 24
35 L @(Q0):2 E  X ^cTXT(0,"N",108) H 3 G 35
 ;
37 S B0=@Q1,PRV=$P(B0,D,23) I $L(PRV) S FP=2403+F60 W @F,@F4,$P($T(T4),U,2),$P(@("^"_Q_"PR(PRV,0)"),D,1)," ",@F5 H 3 S PR=PRV G 31
39 S FP=722 W @F,@F2,$P(B0,D,1) S FP=822 W @F,@F2,$P(B0,D,2) S FP=922 W @F,@F2 S K=$P(B0,D,6) I $L($P(C(106),U,8)) W @$P(C(106),U,8)
40 E  W K
 ;
50 S I2="H",@%Q1=0,X=$D(@Q1),PBS=0
52 S I2=$N(^(I2)),I=0 G 60:$E(I2,1)'="H" S A=^(I2)
54 I DAT=DT K ^(I2) G 52
56 S I=I+1,A1=$P(A,D,I),A2=$P(A,D,I+1,99) G 6:'$L(A1_A2),56:$E(A1,1,6)>DAT1
58 S A2=$P(A,D,1,I-1) S:$L(A2) A2=A2_D S A=A2_$P(A,D,I+1,99),I=I-1,PBS=PBS+$S($E(A1,7)#2:$E(A1,8,99),1:-$E(A1,8,99)) G 56
6 K:'$L(A) ^(I2) S:$L(A) ^(I2)=A G 52
60 I $E($N(^("H")),1)'="H" K ^("H") S ^(0)=$P(B0,D,1,11)_D_$P(B0,D,14)_D_DAT_D_$P(B0,D,14,99),@%Q1=1 L  G 24
61 S X=^("H") G 62:$D(^("H"_$E("000",1,3-$L(X))_X)) S ^("H")=X-1 G 61
62 S ^(0)=$P(B0,D,1,11)_D_($P(B0,D,12)+PBS)_D_DAT_D_$P(B0,D,14,99),@%Q1=1 L  G 24
 ;
YZ Q
 ;
100 F FP=719:100:1019 W @F,@F5
101 S FP=702 W @F,@F4,$P($T(T1),U,2),@F5,":"
102 W !,?1,@F4,$P($T(T2),U,2),@F5,":"
103 W !,?1,@F4,$P($T(T3),U,2),@F5,":" Q
 ;
DCTR ;K?2N1"."2N1"."2N&($P(K,".",1)>0)&($P(K,".",2)>0)&($P(K,".",1)<32)&($P(K,".",2)<13)&'("04060911"[$P(K,".",2)&($P(K,".",1)=31))&'(+$P(K,".",2)=2&(('($P(K,".",3)#4)&($P(K,".",1)>29))!($P(K,".",3)#4&($P(K,".",1)>28))))!("-"[K)
 ;