Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XU8P546

XU8P546.m

Go to the documentation of this file.
  1. XU8P546 ;ISF/RWF - Patch XU-546 Pre/Post init ;10/06/10 16:07
  1. ;;8.0;KERNEL;**546**;;Build 9
  1. ;Fall into
  1. ENV ;Environment Check
  1. N HG,DA,IX,ZTSK,ZTDTH,FIRST,X,Y
  1. S IX=0,U="^"
  1. 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
  1. Q:'$D(HG)
  1. W !,"The following Devices have entries in the HUNT GROUP Multiple (that is"
  1. W !,"to be deleted) and will need to addressed before installing the patch.",!
  1. S DA=0
  1. F S DA=$O(HG(DA)) Q:'DA D SHOW1(DA)
  1. S ZTDTH=0,FIRST=1
  1. F S ZTDTH=$O(^%ZTSCH(ZTDTH)),ZTSK=0 Q:'ZTDTH D
  1. . 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
  1. . . F S IX=$O(HG(IX)) Q:'IX I X=HG(IX)!(Y=HG(IX)) D LABEL:FIRST,EN^XUTMTP(ZTSK) W !
  1. . . Q
  1. . Q
  1. S:$G(XPDENV)=1 XPDQUIT=2 ;Don't install, Leave global
  1. Q
  1. ;
  1. LABEL ;Tasks Lable
  1. S FIRST=0 D ENV^XUTMUTL
  1. W !!,"The following tasks use a Hunt Group Device.",!
  1. Q
  1. ;
  1. PRE ;
  1. Q
  1. ;
  1. POST ;#29 old HG, #30 (3.53) HG Multiple
  1. N DA,DIK,HG,DIU
  1. D BMES^XPDUTL("Removing old Hunt Group field (#29).")
  1. S DA=29,DA(1)=3.5,DIK="^DD(3.5," ;D ^DIK
  1. D BMES^XPDUTL("Removing Hunt Group Multiple (#30).")
  1. S DIU=3.53,DIU(0)="SED" D EN^DIU2
  1. K ^%ZIS(1,"AHG") ;Remove the X-ref.
  1. D PATCH^ZTMGRSET(546)
  1. Q
  1. ;
  1. SHOW1(DA) ;
  1. N X,X1,I
  1. S X=$G(^%ZIS(1,DA,0)),X1=$G(^("TYPE")),HG(DA)=$P(X,U)
  1. W !," Device: "_$P(X,U)_" is type "_X1_" and has the following members."
  1. S I=0
  1. 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)
  1. Q
  1. ;