RTXR2 ; COMPILED XREF FOR FILE #190 ; 10/15/04
;
S DIKZK=1
S DIKZ(0)=$G(^RT(DA,0))
S X=$P(DIKZ(0),U,1)
I X'="" S ^RT("B",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,3)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^RT(D0,0)):^(0),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(190,3,1,1,1.1) X ^DD(190,3,1,1,1.4)
S X=$P(DIKZ(0),U,3)
I X'="" S ^RT("AT",X,$P(^RT(DA,0),U),DA)=""
S DIKZ(0)=$G(^RT(DA,0))
S X=$P(DIKZ(0),U,4)
I X'="" S ^RT("AA",X,$P(^RT(DA,0),U),DA)=""
S X=$P(DIKZ(0),U,5)
I X'="" S ^RT("P",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,6)
I X'="" S ^RT("AH",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,6)
I X'="" X ^DD(190,6,1,2,1)
S DIKZ(0)=$G(^RT(DA,0))
S X=$P(DIKZ(0),U,9)
I X'="" S ^RT("C",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,11)
I X'="" S ^RT("AR",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,13)
I X'="" S:X="y" ^RT("AL",X,DA)=""
S DIKZ("CL")=$G(^RT(DA,"CL"))
S X=$P(DIKZ("CL"),U,5)
I X'="" S ^RT("ABOR",$E(X,1,30),DA)=""
S X=$P(DIKZ("CL"),U,5)
I X'="" X ^DD(190,105,1,2,1)
S DIKZ("CL")=$G(^RT(DA,"CL"))
S X=$P(DIKZ("CL"),U,6)
I X'="" X ^DD(190,106,1,1,1)
S DIKZ("OLDBC")=$G(^RT(DA,"OLDBC"))
S X=$E(DIKZ("OLDBC"),1,45)
I X'="" S ^RT("AOLDBC",$E(X,1,30),DA)=""
END Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTXR2 1249 printed Nov 22, 2024@17:45:30 Page 2
RTXR2 ; COMPILED XREF FOR FILE #190 ; 10/15/04
+1 ;
+2 SET DIKZK=1
+3 SET DIKZ(0)=$GET(^RT(DA,0))
+4 SET X=$PIECE(DIKZ(0),U,1)
+5 IF X'=""
SET ^RT("B",$EXTRACT(X,1,30),DA)=""
+6 SET X=$PIECE(DIKZ(0),U,3)
+7 IF X'=""
Begin DoDot:1
+8 NEW DIK,DIV,DIU,DIN
+9 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^RT(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,4)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(190,3,1,1,1.1)
XECUTE ^DD(190,3,1,1,1.4)
End DoDot:1
+10 SET X=$PIECE(DIKZ(0),U,3)
+11 IF X'=""
SET ^RT("AT",X,$PIECE(^RT(DA,0),U),DA)=""
+12 SET DIKZ(0)=$GET(^RT(DA,0))
+13 SET X=$PIECE(DIKZ(0),U,4)
+14 IF X'=""
SET ^RT("AA",X,$PIECE(^RT(DA,0),U),DA)=""
+15 SET X=$PIECE(DIKZ(0),U,5)
+16 IF X'=""
SET ^RT("P",$EXTRACT(X,1,30),DA)=""
+17 SET X=$PIECE(DIKZ(0),U,6)
+18 IF X'=""
SET ^RT("AH",$EXTRACT(X,1,30),DA)=""
+19 SET X=$PIECE(DIKZ(0),U,6)
+20 IF X'=""
XECUTE ^DD(190,6,1,2,1)
+21 SET DIKZ(0)=$GET(^RT(DA,0))
+22 SET X=$PIECE(DIKZ(0),U,9)
+23 IF X'=""
SET ^RT("C",$EXTRACT(X,1,30),DA)=""
+24 SET X=$PIECE(DIKZ(0),U,11)
+25 IF X'=""
SET ^RT("AR",$EXTRACT(X,1,30),DA)=""
+26 SET X=$PIECE(DIKZ(0),U,13)
+27 IF X'=""
if X="y"
SET ^RT("AL",X,DA)=""
+28 SET DIKZ("CL")=$GET(^RT(DA,"CL"))
+29 SET X=$PIECE(DIKZ("CL"),U,5)
+30 IF X'=""
SET ^RT("ABOR",$EXTRACT(X,1,30),DA)=""
+31 SET X=$PIECE(DIKZ("CL"),U,5)
+32 IF X'=""
XECUTE ^DD(190,105,1,2,1)
+33 SET DIKZ("CL")=$GET(^RT(DA,"CL"))
+34 SET X=$PIECE(DIKZ("CL"),U,6)
+35 IF X'=""
XECUTE ^DD(190,106,1,1,1)
+36 SET DIKZ("OLDBC")=$GET(^RT(DA,"OLDBC"))
+37 SET X=$EXTRACT(DIKZ("OLDBC"),1,45)
+38 IF X'=""
SET ^RT("AOLDBC",$EXTRACT(X,1,30),DA)=""
END QUIT
