- 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
- 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