cA254 ;BEHEER KODES (VERWIJDEREN) ;%A250; Quit naar %A250 [ 12/29/00  4:47 PM ]
 G 1
 ;
T0 ;Beheer codes (verwijderen) ;
T1 ;V[] = definitief verwijderen;
T2 ; bestaat niet; is niet verwijderbaar;
 ;
T0F ;Gestion codes (annuler) ;
T1F ;V[] = radier définitivement;
T2F ; n'existe pas; ne peut pas être radié;
 ;
T0E ;Codes (remove) ;
T1E ;V[] = remove finally;
T2E ; don't exist; is not removable;
 ;
R0 S R0=$P(R,D,5) I $L(R0),R0'["""" S $P(R,D,5)=R0_"^"_$T(+0)
R0A S R0=$P(R,D,7) I $L(R0),R0'="DCTR" S $P(R,D,7)="",R1=$P(R,D,8),R0=$P($T(@R0),U,2,99) S:$L(R1) R0=R0_"&("_R1_")" S $P(R,D,8)=R0
R0Z S $P(R,D,12)=$T(+0) K R0,R1 D ^cA100 Q  ; v11 30.05.94
 ;
1 S (SW12,OK)=1,RRZ="" G YZ:$O(@Q1)=""
10 I $L($P(RSM,D,3)) X $P(RSM,D,3) G 13
11 S R="RRZ\22\3\"_RMS_D_D_$P(RSM,D)_D_D_""",-""[K&$L(K)"_$S($L($P(RMS,D,2)):"!("_$P(RMS,D,2)_")",1:"!$L(K)") D R0
13 G YZ:K="-"!(K=",") I '$D(@Q1) D F1 G 10
19 S R22=@Q1,RL1=$P(RRD,D,2)+2 D S1
 ;
2 S R="K\22\3\"_$P($T(@("T1"_QT)),U,2)_"\\1\\"",-V""[K&$L(K)\\\1" D R0
21 I K="-"!(K=",") S FP=$P(RRD,D,2)+2*100+1 W @F,@F1 G YZ:K=",",10
23 I $L($P(RVW,D,2)) X $P(RVW,D,2)
25 I 'OK D F2 S OK=1 G 10
27 S RL1="" F I=1:1 S RL1=$O(RTA(RL1)) Q:RL1=""  I RTA(RL1)=RRZ Q
28 S R=Q1 K @R D:$D(RDP) @("CV^"_RDP) D S5:$D(RQ)
29 S (RRZ,R22)="" I RL1 K RTA(RL1) D S1,S3
 ;
YZ K OK Q
 ;
F1 S K=RMS_$P($T(@("T2"_QT)),U,2) G FZ
F2 S K=RMS_$P($T(@("T2"_QT)),U,3) G FZ
FZ S FP=2403+F60 W @F,@F4,K,"  [] = ok ",@F5,@F2,@F0 R K Q
 ;
S1 F I=1:1 S X=$P(RRM,D,I) Q:'$L(X)  D S2
S1Z Q
 ;
S2 F II=1:1:4 S @("RS"_II)=$P(X,U,II)
S2A S FP=RL1*100+$P(RRV,U,RS2)+2,K=$S('RS1:@RS1,1:$P(R22,D,RS1#100)) X:$L(RS4) RS4
S2B I RS3="L" W @F,K,$J("",$P(RRV,U,RS2+1)-$P(RRV,U,RS2)-$L(K)-2)
S2C E  S FP=FP-1 W @F,$J(K,$P(RRV,U,RS2+1)-$P(RRV,U,RS2)-1)
S2Z K RS1,RS2,RS3,RS4 Q
 ;
S3 F I=RRL:-1:+RRD Q:$D(RTA(I))
S3Z S:'$D(RTA) I=+RRD-1 S RRL=I+1 Q
 ;
 ; killen voor meerdere Q-Waarden (safety shop)
S5 G S5Z:'$P(RQ,D) S RS1=R S:$E(RS1)="^" RS1=$E(RS1,2,999) S RS1=$E(RS1,1+$P(RQ,D),999)
S5A F RS2=2:1 S RS3=$P(RQ,D,RS2) Q:RS3=""  D
 . K @("^"_QS_RS3_RS1) D:$D(RDP) @("CVRQ^"_RDP)
S5Z K RS1,RS2,RS3 Q
 ;
Z X ^cZ Q
ZZ ; 05.02.01 - 16 u 23 * V7.84