SR3189P ;ALB/BJR - DELETE OLD ADT AND ARS X-REF ; 8/15/16 3:36pm
;;3.0;Surgery;**189**;24 Jun 93;Build 3
;
Q
EN ; Entry point
; Delete old ARS and ADT x-ref
Q:$$PATCH^XPDUTL("SR*3.0*189") ;Patch has already been installed
N SRERR,SRERR1,SRMSG
D DELIX^DDMOD(130,.09,2,,,"SRERR") I $D(SRERR) D
.D BMES^XPDUTL("An error has occured when attempting to delete the 'ADT' x-ref.")
.I $D(SRERR("DIERR",1,"TEXT")) S SRMSG=0 F S SRMSG=$O(SRERR("DIERR",1,"TEXT",SRMSG)) Q:'SRMSG D
..D BMES^XPDUTL(SRERR("DIERR",1,"TEXT",SRMSG))
.D BMES^XPDUTL("Please contact local site support.")
D DELIX^DDMOD(130,235,1,,,"SRERR1") I $D(SRERR1) D
.D BMES^XPDUTL("An error has occured when attempting to delete the 'ARS' x-ref.")
.I $D(SRERR1("DIERR",1,"TEXT")) S SRMSG=0 F S SRMSG=$O(SRERR1("DIERR",1,"TEXT",SRMSG)) Q:'SRMSG D
..D BMES^XPDUTL(SRERR1("DIERR",1,"TEXT",SRMSG))
.D BMES^XPDUTL("Please contact local site support.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSR3189P 945 printed Dec 13, 2024@02:38:39 Page 2
SR3189P ;ALB/BJR - DELETE OLD ADT AND ARS X-REF ; 8/15/16 3:36pm
+1 ;;3.0;Surgery;**189**;24 Jun 93;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("SR*3.0*189")
QUIT
+3 NEW SRERR,SRERR1,SRMSG
+4 DO DELIX^DDMOD(130,.09,2,,,"SRERR")
IF $DATA(SRERR)
Begin DoDot:1
+5 DO BMES^XPDUTL("An error has occured when attempting to delete the 'ADT' x-ref.")
+6 IF $DATA(SRERR("DIERR",1,"TEXT"))
SET SRMSG=0
FOR
SET SRMSG=$ORDER(SRERR("DIERR",1,"TEXT",SRMSG))
if 'SRMSG
QUIT
Begin DoDot:2
+7 DO BMES^XPDUTL(SRERR("DIERR",1,"TEXT",SRMSG))
End DoDot:2
+8 DO BMES^XPDUTL("Please contact local site support.")
End DoDot:1
+9 DO DELIX^DDMOD(130,235,1,,,"SRERR1")
IF $DATA(SRERR1)
Begin DoDot:1
+10 DO BMES^XPDUTL("An error has occured when attempting to delete the 'ARS' x-ref.")
+11 IF $DATA(SRERR1("DIERR",1,"TEXT"))
SET SRMSG=0
FOR
SET SRMSG=$ORDER(SRERR1("DIERR",1,"TEXT",SRMSG))
if 'SRMSG
QUIT
Begin DoDot:2
+12 DO BMES^XPDUTL(SRERR1("DIERR",1,"TEXT",SRMSG))
End DoDot:2
+13 DO BMES^XPDUTL("Please contact local site support.")
End DoDot:1
+14 QUIT
