RTXR1.m

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 ---RTXR1   820     printed  Mar 13, 2025@21:40:35                                                                                                                                                                                                        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