XU8P546 ;ISF/RWF - Patch XU-546 Pre/Post init ;10/06/10 16:07
;;8.0;KERNEL;**546**;;Build 9
;Fall into
ENV ;Environment Check
N HG,DA,IX,ZTSK,ZTDTH,FIRST,X,Y
S IX=0,U="^"
F S IX=$O(^%ZIS(1,"AHG",IX)),DA=0 Q:'IX F S DA=$O(^%ZIS(1,"AHG",IX,DA)) Q:'DA S HG(DA)=0
Q:'$D(HG)
W !,"The following Devices have entries in the HUNT GROUP Multiple (that is"
W !,"to be deleted) and will need to addressed before installing the patch.",!
S DA=0
F S DA=$O(HG(DA)) Q:'DA D SHOW1(DA)
S ZTDTH=0,FIRST=1
F S ZTDTH=$O(^%ZTSCH(ZTDTH)),ZTSK=0 Q:'ZTDTH D
. F S ZTSK=$O(^%ZTSCH(ZTDTH,ZTSK)),IX=0 Q:'ZTSK S X=$P($P($G(^%ZTSK(ZTSK,.2)),U),";"),Y=$P($G(^(.26)),U) D
. . F S IX=$O(HG(IX)) Q:'IX I X=HG(IX)!(Y=HG(IX)) D LABEL:FIRST,EN^XUTMTP(ZTSK) W !
. . Q
. Q
S:$G(XPDENV)=1 XPDQUIT=2 ;Don't install, Leave global
Q
;
LABEL ;Tasks Lable
S FIRST=0 D ENV^XUTMUTL
W !!,"The following tasks use a Hunt Group Device.",!
Q
;
PRE ;
Q
;
POST ;#29 old HG, #30 (3.53) HG Multiple
N DA,DIK,HG,DIU
D BMES^XPDUTL("Removing old Hunt Group field (#29).")
S DA=29,DA(1)=3.5,DIK="^DD(3.5," ;D ^DIK
D BMES^XPDUTL("Removing Hunt Group Multiple (#30).")
S DIU=3.53,DIU(0)="SED" D EN^DIU2
K ^%ZIS(1,"AHG") ;Remove the X-ref.
D PATCH^ZTMGRSET(546)
Q
;
SHOW1(DA) ;
N X,X1,I
S X=$G(^%ZIS(1,DA,0)),X1=$G(^("TYPE")),HG(DA)=$P(X,U)
W !," Device: "_$P(X,U)_" is type "_X1_" and has the following members."
S I=0
F S I=$O(^%ZIS(1,DA,"HG",I)) Q:'I S X1=^%ZIS(1,DA,"HG",I,0),X=$G(^%ZIS(1,X1,0)) W !,?5,$P(X,U)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P546 1561 printed Dec 13, 2024@02:08:09 Page 2
XU8P546 ;ISF/RWF - Patch XU-546 Pre/Post init ;10/06/10 16:07
+1 ;;8.0;KERNEL;**546**;;Build 9
+2 ;Fall into
ENV ;Environment Check
+1 NEW HG,DA,IX,ZTSK,ZTDTH,FIRST,X,Y
+2 SET IX=0
SET U="^"
+3 FOR
SET IX=$ORDER(^%ZIS(1,"AHG",IX))
SET DA=0
if 'IX
QUIT
FOR
SET DA=$ORDER(^%ZIS(1,"AHG",IX,DA))
if 'DA
QUIT
SET HG(DA)=0
+4 if '$DATA(HG)
QUIT
+5 WRITE !,"The following Devices have entries in the HUNT GROUP Multiple (that is"
+6 WRITE !,"to be deleted) and will need to addressed before installing the patch.",!
+7 SET DA=0
+8 FOR
SET DA=$ORDER(HG(DA))
if 'DA
QUIT
DO SHOW1(DA)
+9 SET ZTDTH=0
SET FIRST=1
+10 FOR
SET ZTDTH=$ORDER(^%ZTSCH(ZTDTH))
SET ZTSK=0
if 'ZTDTH
QUIT
Begin DoDot:1
+11 FOR
SET ZTSK=$ORDER(^%ZTSCH(ZTDTH,ZTSK))
SET IX=0
if 'ZTSK
QUIT
SET X=$PIECE($PIECE($GET(^%ZTSK(ZTSK,.2)),U),";")
SET Y=$PIECE($GET(^(.26)),U)
Begin DoDot:2
+12 FOR
SET IX=$ORDER(HG(IX))
if 'IX
QUIT
IF X=HG(IX)!(Y=HG(IX))
if FIRST
DO LABEL
DO EN^XUTMTP(ZTSK)
WRITE !
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 ;Don't install, Leave global
if $GET(XPDENV)=1
SET XPDQUIT=2
+16 QUIT
+17 ;
LABEL ;Tasks Lable
+1 SET FIRST=0
DO ENV^XUTMUTL
+2 WRITE !!,"The following tasks use a Hunt Group Device.",!
+3 QUIT
+4 ;
PRE ;
+1 QUIT
+2 ;
POST ;#29 old HG, #30 (3.53) HG Multiple
+1 NEW DA,DIK,HG,DIU
+2 DO BMES^XPDUTL("Removing old Hunt Group field (#29).")
+3 ;D ^DIK
SET DA=29
SET DA(1)=3.5
SET DIK="^DD(3.5,"
+4 DO BMES^XPDUTL("Removing Hunt Group Multiple (#30).")
+5 SET DIU=3.53
SET DIU(0)="SED"
DO EN^DIU2
+6 ;Remove the X-ref.
KILL ^%ZIS(1,"AHG")
+7 DO PATCH^ZTMGRSET(546)
+8 QUIT
+9 ;
SHOW1(DA) ;
+1 NEW X,X1,I
+2 SET X=$GET(^%ZIS(1,DA,0))
SET X1=$GET(^("TYPE"))
SET HG(DA)=$PIECE(X,U)
+3 WRITE !," Device: "_$PIECE(X,U)_" is type "_X1_" and has the following members."
+4 SET I=0
+5 FOR
SET I=$ORDER(^%ZIS(1,DA,"HG",I))
if 'I
QUIT
SET X1=^%ZIS(1,DA,"HG",I,0)
SET X=$GET(^%ZIS(1,X1,0))
WRITE !,?5,$PIECE(X,U)
+6 QUIT
+7 ;
