cA243 ;MODULES I.V.M. ALPHA-KODE ;%A200 ; [ 09/26/94  11:37 AM ]
 ;
T0 ;Modules i.v.m. alpha-code ;
 ;
T0F ;Modules pour le code apha ;
 ;
T0E ;Modules i.v.m. alpha-code ;
 G YZ
 ;
 ; alpha-instruktie vlak voor centraal adressenbeheer bij openen
SO I '$D(@("^"_Q_"BA(""%A"",7,Q1,0)")) G SOZ
SOA S:'$D(X3) X3="" S X3=X3_$S($L(X3):",",1:"")_"S1^cA243"
SOZ S R=$D(@("^"_Q_Q1_"(0,0)")) Q
 ;
 ; alpha-instruktie vlak voor centraal adressenbeheer bij wijzigen
SW I '$D(@("^"_Q_"BA(""%A"",7,Q1,0)")) G SWZ
SWA S:'$D(X3) X3="" S X3=X3_$S($L(X3):",",1:"")_"S2^cA243"
SWZ S R=$D(@("^"_Q_Q1_"(0,0)")) Q
 ;
 ; alpha-instruktie vlak voor centraal adressenbeheer bij verwijderen
SV I '$D(@("^"_Q_"BA(""%A"",7,Q1,0)")) G SVZ
SVA S:'$D(X3) X3="" S $P(X3,U,2)=$P(X3,U,2)_$S($L($P(X3,U,2)):",",1:"")_"S3^cA243"
SVZ S R=$D(@("^"_Q_Q1_"(0,0)")) Q
 ;
 ; execute bij openen via Q_Q1(0,2)
S1 I $D(OK),'OK G S1Z
S1A I '$D(OK) S OK=2
S1B K RB S RB($P(^(@("^"_Q_"BA(""%A"",7,Q1,0)")),D))=D,RB=0 F R=1:1 S RB=$O(^(RB)) Q:RB=""  S RB($P(^(RB),D))=D
S1C K RB(101),RB(102)
S1D F R1=1:1 S RB=$O(RB(RB)) Q:RB=""  S R=$P(B(RB\100),D,RB#100) I $L(R) D S10 S @("^"_Q_Q1_RB_"(R)")=$P(B(1),D)
S1Z K R,RB,R1 Q
 ;
 ; execute bij wijzigen via Q_Q1(0,3)
S2 I $D(OK),'OK G S2Z
S2A I '$D(OK) S OK=2
S2B K RB S RB($P(^(@("^"_Q_"BA(""%A"",7,Q1,0)")),D))=D,RB=0 F R=1:1 S RB=$O(^(RB)) Q:RB=""  S RB($P(^(RB),D))=D
S2C K RB(101),RB(102)
S2D F R1=1:1 S RB=$O(RB(RB)) Q:RB=""  S RO=$P(@("^"_Q_Q1_"(I1,RB\100-1)"),D,RB#100),RN=$P(B(RB\100),D,RB#100) I RN'=RO S R=RO D S10 K @("^"_Q_Q1_RB_"(R)") S R=RN D S10 S @("^"_Q_Q1_RB_"(R)")=$P(B(1),D)
S2Z K R,RB,R1,RO,RN Q
 ;
 ; execute bij verwijderen via Q_Q1(0,4)
S3 I $D(OK),'OK G S3Z
S3A I '$D(OK) S OK=2
S3B K RB S RB($P(^(@("^"_Q_"BA(""%A"",7,Q1,0)")),D))=D,RB=0 F R=1:1 S RB=$O(^(RB)) Q:RB=""  S RB($P(^(RB),D))=D
S3C K RB(101),RB(102)
S3D F R1=1:1 S RB=$O(RB(RB)) Q:RB=""  S RO=$P(@("^"_Q_Q1_"(I1,RB\100-1)"),D,RB#100) S R=RO D S10 K @("^"_Q_Q1_RB_"(R)")
S3Z K R,RB,R1,RO Q
 ;
 ; opbouw index
S10 S S02=R,R=""
S10A F S03=1:1:$L(S02) S S01=$E(S02,S03),S04=$A(S01) S:S04>96&(S04<123) S01=$C(S04-32) S:S01'?1P R=R_S01
S10B S R=$E(R,1,24)_" "_$P(B(1),D)
S10Z K S01,S02,S03,S04 Q
 ;
YZ Q
 ;
Z X ^cZ
ZZ ; 05.02.01 - 16 u 23 * V7.84