RTXR1 ; COMPILED XREF FOR FILE #190 ; 10/15/04
;
S DIKZK=2
S DIKZ(0)=$G(^RT(DA,0))
S X=$P(DIKZ(0),U,3)
I X'="" K ^RT("AT",X,$P(^RT(DA,0),U),DA)
S X=$P(DIKZ(0),U,4)
I X'="" K ^RT("AA",X,$P(^RT(DA,0),U),DA)
S X=$P(DIKZ(0),U,5)
I X'="" K ^RT("P",$E(X,1,30),DA)
S X=$P(DIKZ(0),U,6)
I X'="" K ^RT("AH",$E(X,1,30),DA)
S X=$P(DIKZ(0),U,9)
I X'="" K ^RT("C",$E(X,1,30),DA)
S X=$P(DIKZ(0),U,11)
I X'="" K ^RT("AR",$E(X,1,30),DA)
S X=$P(DIKZ(0),U,13)
I X'="" K ^RT("AL",X,DA)
S DIKZ("CL")=$G(^RT(DA,"CL"))
S X=$P(DIKZ("CL"),U,5)
I X'="" K ^RT("ABOR",$E(X,1,30),DA)
S X=$P(DIKZ("CL"),U,6)
I X'="" K ^RT("AC",X,DA)
S DIKZ("OLDBC")=$G(^RT(DA,"OLDBC"))
S X=$E(DIKZ("OLDBC"),1,45)
I X'="" K ^RT("AOLDBC",$E(X,1,30),DA)
S X=$P(DIKZ(0),U,1)
I X'="" K ^RT("B",$E(X,1,30),DA)
END Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTXR1 820 printed Dec 13, 2024@02:35:29 Page 2
RTXR1 ; COMPILED XREF FOR FILE #190 ; 10/15/04
+1 ;
+2 SET DIKZK=2
+3 SET DIKZ(0)=$GET(^RT(DA,0))
+4 SET X=$PIECE(DIKZ(0),U,3)
+5 IF X'=""
KILL ^RT("AT",X,$PIECE(^RT(DA,0),U),DA)
+6 SET X=$PIECE(DIKZ(0),U,4)
+7 IF X'=""
KILL ^RT("AA",X,$PIECE(^RT(DA,0),U),DA)
+8 SET X=$PIECE(DIKZ(0),U,5)
+9 IF X'=""
KILL ^RT("P",$EXTRACT(X,1,30),DA)
+10 SET X=$PIECE(DIKZ(0),U,6)
+11 IF X'=""
KILL ^RT("AH",$EXTRACT(X,1,30),DA)
+12 SET X=$PIECE(DIKZ(0),U,9)
+13 IF X'=""
KILL ^RT("C",$EXTRACT(X,1,30),DA)
+14 SET X=$PIECE(DIKZ(0),U,11)
+15 IF X'=""
KILL ^RT("AR",$EXTRACT(X,1,30),DA)
+16 SET X=$PIECE(DIKZ(0),U,13)
+17 IF X'=""
KILL ^RT("AL",X,DA)
+18 SET DIKZ("CL")=$GET(^RT(DA,"CL"))
+19 SET X=$PIECE(DIKZ("CL"),U,5)
+20 IF X'=""
KILL ^RT("ABOR",$EXTRACT(X,1,30),DA)
+21 SET X=$PIECE(DIKZ("CL"),U,6)
+22 IF X'=""
KILL ^RT("AC",X,DA)
+23 SET DIKZ("OLDBC")=$GET(^RT(DA,"OLDBC"))
+24 SET X=$EXTRACT(DIKZ("OLDBC"),1,45)
+25 IF X'=""
KILL ^RT("AOLDBC",$EXTRACT(X,1,30),DA)
+26 SET X=$PIECE(DIKZ(0),U,1)
+27 IF X'=""
KILL ^RT("B",$EXTRACT(X,1,30),DA)
END QUIT
