SR3189P.m

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 ---SR3189P   945     printed  Mar 13, 2025@21:43:51                                                                                                                                                                                                      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