Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RA95PST

RA95PST.m

Go to the documentation of this file.
  1. 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
  1. Q
  1. EN ;Clean up "ASTF" and "ARES" from deleted reports that are caused
  1. ;by patch 56
  1. N A,I,I1,J,RA,RAPS,RAPR,RASS,RASR,X
  1. D EN^DDIOL("Searching deleted reports' left-over ""ASTF"" and ""ARES"" xrefs...",,"!,?6")
  1. D EN^DDIOL("",,"!")
  1. S (I,J)=0
  1. F S I=$O(^RARPT("ASTAT","X",I)) Q:'I D
  1. .Q:$P(^RARPT(I,0),"^",5)'="X" ;quit if report status isn't "X"
  1. .S X=$O(^RARPT(I,"L",""),-1) Q:'X
  1. .S RA=^RARPT(I,"L",X,0) Q:RA=""
  1. .S RAPS=$P(RA,"^",7) ;Primary Staff
  1. .S RAPR=$P(RA,"^",9) ;Primary Resident
  1. .S A=$NA(^RARPT("ASTF",+RAPS,I)) D CHECK
  1. .S A=$NA(^RARPT("ARES",+RAPR,I)) D CHECK
  1. .I $O(^RARPT(I,"L",X,"DELSTF",0)) S I1=0 D ;Secondary Staff
  1. ..F S I1=$O(^RARPT(I,"L",X,"DELSTF","B",I1)) Q:'I1 D
  1. ...S A=$NA(^RARPT("ASTF",I1,I)) D CHECK
  1. ...Q
  1. ..Q
  1. .I $O(^RARPT(I,"L",X,"DELRES",0)) S I1=0 D ;Secondary Residents
  1. ..F S I1=$O(^RARPT(I,"L",X,"DELRES","B",I1)) Q:'I1 D
  1. ...S A=$NA(^RARPT("ARES",I1,I)) D CHECK
  1. ...Q
  1. ..Q
  1. .Q
  1. I 'J D EN^DDIOL("No left-over ""ASTF"" and ""ARES"" to delete",,"!!,?6")
  1. D EN^DDIOL("",,"!")
  1. Q
  1. CHECK ; If xref exists, then kill it
  1. I $D(@A)#2 K @A D DISPLAY S J=J+1
  1. Q
  1. DISPLAY ;
  1. D EN^DDIOL(A_" erased from database",,"!,?6")
  1. Q