RA95PST ;Hines OI/SWM - Post-init, patch 95 ;09/29/08 09:45
;;5.0;Radiology/Nuclear Medicine;**95**;Mar 16, 1998;Build 7
Q
EN ;Clean up "ASTF" and "ARES" from deleted reports that are caused
;by patch 56
N A,I,I1,J,RA,RAPS,RAPR,RASS,RASR,X
D EN^DDIOL("Searching deleted reports' left-over ""ASTF"" and ""ARES"" xrefs...",,"!,?6")
D EN^DDIOL("",,"!")
S (I,J)=0
F S I=$O(^RARPT("ASTAT","X",I)) Q:'I D
.Q:$P(^RARPT(I,0),"^",5)'="X" ;quit if report status isn't "X"
.S X=$O(^RARPT(I,"L",""),-1) Q:'X
.S RA=^RARPT(I,"L",X,0) Q:RA=""
.S RAPS=$P(RA,"^",7) ;Primary Staff
.S RAPR=$P(RA,"^",9) ;Primary Resident
.S A=$NA(^RARPT("ASTF",+RAPS,I)) D CHECK
.S A=$NA(^RARPT("ARES",+RAPR,I)) D CHECK
.I $O(^RARPT(I,"L",X,"DELSTF",0)) S I1=0 D ;Secondary Staff
..F S I1=$O(^RARPT(I,"L",X,"DELSTF","B",I1)) Q:'I1 D
...S A=$NA(^RARPT("ASTF",I1,I)) D CHECK
...Q
..Q
.I $O(^RARPT(I,"L",X,"DELRES",0)) S I1=0 D ;Secondary Residents
..F S I1=$O(^RARPT(I,"L",X,"DELRES","B",I1)) Q:'I1 D
...S A=$NA(^RARPT("ARES",I1,I)) D CHECK
...Q
..Q
.Q
I 'J D EN^DDIOL("No left-over ""ASTF"" and ""ARES"" to delete",,"!!,?6")
D EN^DDIOL("",,"!")
Q
CHECK ; If xref exists, then kill it
I $D(@A)#2 K @A D DISPLAY S J=J+1
Q
DISPLAY ;
D EN^DDIOL(A_" erased from database",,"!,?6")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRA95PST 1321 printed Sep 23, 2025@20:09:37 Page 2
RA95PST ;Hines OI/SWM - Post-init, patch 95 ;09/29/08 09:45
+1 ;;5.0;Radiology/Nuclear Medicine;**95**;Mar 16, 1998;Build 7
+2 QUIT
EN ;Clean up "ASTF" and "ARES" from deleted reports that are caused
+1 ;by patch 56
+2 NEW A,I,I1,J,RA,RAPS,RAPR,RASS,RASR,X
+3 DO EN^DDIOL("Searching deleted reports' left-over ""ASTF"" and ""ARES"" xrefs...",,"!,?6")
+4 DO EN^DDIOL("",,"!")
+5 SET (I,J)=0
+6 FOR
SET I=$ORDER(^RARPT("ASTAT","X",I))
if 'I
QUIT
Begin DoDot:1
+7 ;quit if report status isn't "X"
if $PIECE(^RARPT(I,0),"^",5)'="X"
QUIT
+8 SET X=$ORDER(^RARPT(I,"L",""),-1)
if 'X
QUIT
+9 SET RA=^RARPT(I,"L",X,0)
if RA=""
QUIT
+10 ;Primary Staff
SET RAPS=$PIECE(RA,"^",7)
+11 ;Primary Resident
SET RAPR=$PIECE(RA,"^",9)
+12 SET A=$NAME(^RARPT("ASTF",+RAPS,I))
DO CHECK
+13 SET A=$NAME(^RARPT("ARES",+RAPR,I))
DO CHECK
+14 ;Secondary Staff
IF $ORDER(^RARPT(I,"L",X,"DELSTF",0))
SET I1=0
Begin DoDot:2
+15 FOR
SET I1=$ORDER(^RARPT(I,"L",X,"DELSTF","B",I1))
if 'I1
QUIT
Begin DoDot:3
+16 SET A=$NAME(^RARPT("ASTF",I1,I))
DO CHECK
+17 QUIT
End DoDot:3
+18 QUIT
End DoDot:2
+19 ;Secondary Residents
IF $ORDER(^RARPT(I,"L",X,"DELRES",0))
SET I1=0
Begin DoDot:2
+20 FOR
SET I1=$ORDER(^RARPT(I,"L",X,"DELRES","B",I1))
if 'I1
QUIT
Begin DoDot:3
+21 SET A=$NAME(^RARPT("ARES",I1,I))
DO CHECK
+22 QUIT
End DoDot:3
+23 QUIT
End DoDot:2
+24 QUIT
End DoDot:1
+25 IF 'J
DO EN^DDIOL("No left-over ""ASTF"" and ""ARES"" to delete",,"!!,?6")
+26 DO EN^DDIOL("",,"!")
+27 QUIT
CHECK ; If xref exists, then kill it
+1 IF $DATA(@A)#2
KILL @A
DO DISPLAY
SET J=J+1
+2 QUIT
DISPLAY ;
+1 DO EN^DDIOL(A_" erased from database",,"!,?6")
+2 QUIT
