RA5130P ;ALB/BJR - DELETE OLD AS AND AP X-REF ; 8/16/16 10:36am
;;5.0;Radiology/Nuclear Medicine;**130**;Mar 16, 1998;Build 3
;
Q
EN ; Entry point
; Delete old ARS and ADT x-ref
Q:$$PATCH^XPDUTL("RA*5.0*130") ;Patch has already been installed
N RAERR,RAERR1,RAMSG
D DELIX^DDMOD(75.1,2,1,,,"RAERR") I $D(RAERR) D
.D BMES^XPDUTL("An error has occured when attempting to delete the 'ADT' x-ref.")
.I $D(RAERR("DIERR",1,"TEXT")) S RAMSG=0 F S RAMSG=$O(RAERR("DIERR",1,"TEXT",RAMSG)) Q:'RAMSG D
..D BMES^XPDUTL(RAERR("DIERR",1,"TEXT",RAMSG))
.D BMES^XPDUTL("Please contact local site support.")
D DELIX^DDMOD(75.1,5,1,,,"RAERR1") I $D(RAERR1) D
.D BMES^XPDUTL("An error has occured when attempting to delete the 'ARS' x-ref.")
.I $D(RAERR1("DIERR",1,"TEXT")) S RAMSG=0 F S RAMSG=$O(RAERR1("DIERR",1,"TEXT",RAMSG)) Q:'RAMSG D
..D BMES^XPDUTL(RAERR1("DIERR",1,"TEXT",RAMSG))
.D BMES^XPDUTL("Please contact local site support.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRA5130P 964 printed Nov 22, 2024@17:43:23 Page 2
RA5130P ;ALB/BJR - DELETE OLD AS AND AP X-REF ; 8/16/16 10:36am
+1 ;;5.0;Radiology/Nuclear Medicine;**130**;Mar 16, 1998;Build 3
+2 ;
+3 QUIT
EN ; Entry point
+1 ; Delete old ARS and ADT x-ref
+2 ;Patch has already been installed
if $$PATCH^XPDUTL("RA*5.0*130")
QUIT
+3 NEW RAERR,RAERR1,RAMSG
+4 DO DELIX^DDMOD(75.1,2,1,,,"RAERR")
IF $DATA(RAERR)
Begin DoDot:1
+5 DO BMES^XPDUTL("An error has occured when attempting to delete the 'ADT' x-ref.")
+6 IF $DATA(RAERR("DIERR",1,"TEXT"))
SET RAMSG=0
FOR
SET RAMSG=$ORDER(RAERR("DIERR",1,"TEXT",RAMSG))
if 'RAMSG
QUIT
Begin DoDot:2
+7 DO BMES^XPDUTL(RAERR("DIERR",1,"TEXT",RAMSG))
End DoDot:2
+8 DO BMES^XPDUTL("Please contact local site support.")
End DoDot:1
+9 DO DELIX^DDMOD(75.1,5,1,,,"RAERR1")
IF $DATA(RAERR1)
Begin DoDot:1
+10 DO BMES^XPDUTL("An error has occured when attempting to delete the 'ARS' x-ref.")
+11 IF $DATA(RAERR1("DIERR",1,"TEXT"))
SET RAMSG=0
FOR
SET RAMSG=$ORDER(RAERR1("DIERR",1,"TEXT",RAMSG))
if 'RAMSG
QUIT
Begin DoDot:2
+12 DO BMES^XPDUTL(RAERR1("DIERR",1,"TEXT",RAMSG))
End DoDot:2
+13 DO BMES^XPDUTL("Please contact local site support.")
End DoDot:1
+14 QUIT
