- 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 Jan 18, 2025@03:09:20 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 ;