RA95PST.m

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