RA5130P.m

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 ---RA5130P   964     printed  Mar 13, 2025@21:38:10                                                                                                                                                                                                      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