SR84UTL.m

SR84UTL ;BIR/ADM-Utility Routine for SR*3*84 ; [ 12/02/98  10:58 AM ]

 ;;3.0; Surgery ;**84**;24 Jun 93

 ;

 ; References to fields 20 and 22 of file 19 are supported by DBIA #2509

 ;

 ; environmental check to confirm that XU*8*87 is installed

 I '$$PATCH^XPDUTL("XU*8.0*87") D BMES^XPDUTL("Patch XU*8*87 must be installed before installing this patch!") S XPDQUIT=2 Q

 I $S($D(DUZ)[0:1,$D(DUZ(0))[0:1,'DUZ:1,1:0) D BMES^XPDUTL(">> DUZ and DUZ(0) must be defined as an active user to install.") S XPDQUIT=2 Q

 I $S('$D(DUZ(0)):1,DUZ(0)'="@":1,1:0) D BMES^XPDUTL("Patch installation requires PROGRAMMER ACCESS.") S XPDQUIT=2

 Q

POST ; update XQUIT EXECUTABLE field in OPTION file for Surgery options

 N DA,DIE,DR,SR19,SRACT,SROPT,SRXQ

 S SR19="SR" F  S SR19=$O(^DIC(19,"B",SR19)) Q:$E(SR19,1,2)'="SR"  S SROPT=0 F  S SROPT=$O(^DIC(19,"B",SR19,SROPT)) Q:'SROPT  D

 .S SRACT=$$GET1^DIQ(19,SROPT,20) I SRACT'["SROVAR" Q

 .D MES^XPDUTL("Updating option "_SR19)

 .K DA,DIE,DR S DA=SROPT,DIE=19,DR="22////Q" D ^DIE

 .S SRXQ=$$GET1^DIQ(19,SROPT,22) I SRXQ'="Q" D MES^XPDUTL("  >>> "_SR19_" update FAILED.")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SR84UTL   1119     printed  Apr 09, 2024@21:44:59                                                                                                                                                                                                     Page 2

SR84UTL   ;BIR/ADM-Utility Routine for SR*3*84 ; [ 12/02/98  10:58 AM ]

 +1       ;;3.0; Surgery ;**84**;24 Jun 93

 +2       ;

 +3       ; References to fields 20 and 22 of file 19 are supported by DBIA #2509

 +4       ;

 +5       ; environmental check to confirm that XU*8*87 is installed

 +6        IF '$$PATCH^XPDUTL("XU*8.0*87")

               DO BMES^XPDUTL("Patch XU*8*87 must be installed before installing this patch!")

               SET XPDQUIT=2

               QUIT 

 +7        IF $SELECT($DATA(DUZ)[0:1,$DATA(DUZ(0))[0:1,'DUZ:1,1:0)

               DO BMES^XPDUTL(">> DUZ and DUZ(0) must be defined as an active user to install.")

               SET XPDQUIT=2

               QUIT 

 +8        IF $SELECT('$DATA(DUZ(0)):1,DUZ(0)'="@":1,1:0)

               DO BMES^XPDUTL("Patch installation requires PROGRAMMER ACCESS.")

               SET XPDQUIT=2

 +9        QUIT 

POST      ; update XQUIT EXECUTABLE field in OPTION file for Surgery options

 +1        NEW DA,DIE,DR,SR19,SRACT,SROPT,SRXQ

 +2        SET SR19="SR"

           FOR 

               SET SR19=$ORDER(^DIC(19,"B",SR19))

               if $EXTRACT(SR19,1,2)'="SR"

                   QUIT 

               SET SROPT=0

               FOR 

                   SET SROPT=$ORDER(^DIC(19,"B",SR19,SROPT))

                   if 'SROPT

                       QUIT 

                   Begin DoDot:1

 +3                    SET SRACT=$$GET1^DIQ(19,SROPT,20)

                       IF SRACT'["SROVAR"

                           QUIT 

 +4                    DO MES^XPDUTL("Updating option "_SR19)

 +5                    KILL DA,DIE,DR

                       SET DA=SROPT

                       SET DIE=19

                       SET DR="22////Q"

                       DO ^DIE

 +6                    SET SRXQ=$$GET1^DIQ(19,SROPT,22)

                       IF SRXQ'="Q"

                           DO MES^XPDUTL("  >>> "_SR19_" update FAILED.")

                   End DoDot:1

 +7        QUIT