XU8P440 ;ISF/RWF - Post-INIT for XU*8*440. ;01/17/2008
;;8.0;KERNEL;**440**;Jul 10, 1995;Build 13
Q
POST ;Post-INIT
D DD35,DD32,DDGBL,DD8989
D RELOAD^ZTMGRSET
Q
DD35 ;Remove old HUNT GROUP field #29. OLDXY is in p463
N %,DA,DIK
I $E($G(^DD(3.5,29,0)),1)="*" D
. F DA=0:0 S DA=$O(^%ZIS(1,DA)) Q:'DA S %=$G(^(DA,0)) I $L($P(%,U,10)) S $P(^(0),U,10)=""
. S DIK="^DD(3.5,",DA=29,DA(1)=3.5 D ^DIK
Q
;
DD32 ;
N DA,DIK
I $E($G(^DD(3.2,408,0)),1)="*" D
. F DA=0:0 S DA=$O(^%ZIS(2,DA)) Q:'DA K ^%ZIS(2,DA,408),^%ZIS(2,DA,409)
. S DIK="^DD(3.2,",DA=408,DA(1)=3.2 D ^DIK
. Q
I $E($G(^DD(3.2,409,0)),1)="*" D
. S DIK="^DD(3.2,",DA=409,DA(1)=3.2 D ^DIK
. Q
Q
;
DD8989 ;See that MIXED OS is a 0 or 1
N X
S X=$P($G(^XTV(8989.3,1,0)),"^",5)
S $P(^XTV(8989.3,1,0),"^",5)=+X
Q
;
DDGBL ;Convert any data in the 'GBL' node to match new DD.
N DA,X,CNT
S DA=0,CNT=0
F S DA=$O(^%ZIS(1,DA)) Q:'DA I $D(^(DA,"GBL")) D
. S X=^%ZIS(1,DA,"GBL")
. S:$L(X) ^%ZIS(1,DA,"GBL")=1,CNT=CNT+1
. Q
W !,?5,CNT," 'GBL' nodes converted."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P440 1078 printed Nov 22, 2024@17:17:49 Page 2
XU8P440 ;ISF/RWF - Post-INIT for XU*8*440. ;01/17/2008
+1 ;;8.0;KERNEL;**440**;Jul 10, 1995;Build 13
+2 QUIT
POST ;Post-INIT
+1 DO DD35
DO DD32
DO DDGBL
DO DD8989
+2 DO RELOAD^ZTMGRSET
+3 QUIT
DD35 ;Remove old HUNT GROUP field #29. OLDXY is in p463
+1 NEW %,DA,DIK
+2 IF $EXTRACT($GET(^DD(3.5,29,0)),1)="*"
Begin DoDot:1
+3 FOR DA=0:0
SET DA=$ORDER(^%ZIS(1,DA))
if 'DA
QUIT
SET %=$GET(^(DA,0))
IF $LENGTH($PIECE(%,U,10))
SET $PIECE(^(0),U,10)=""
+4 SET DIK="^DD(3.5,"
SET DA=29
SET DA(1)=3.5
DO ^DIK
End DoDot:1
+5 QUIT
+6 ;
DD32 ;
+1 NEW DA,DIK
+2 IF $EXTRACT($GET(^DD(3.2,408,0)),1)="*"
Begin DoDot:1
+3 FOR DA=0:0
SET DA=$ORDER(^%ZIS(2,DA))
if 'DA
QUIT
KILL ^%ZIS(2,DA,408),^%ZIS(2,DA,409)
+4 SET DIK="^DD(3.2,"
SET DA=408
SET DA(1)=3.2
DO ^DIK
+5 QUIT
End DoDot:1
+6 IF $EXTRACT($GET(^DD(3.2,409,0)),1)="*"
Begin DoDot:1
+7 SET DIK="^DD(3.2,"
SET DA=409
SET DA(1)=3.2
DO ^DIK
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
DD8989 ;See that MIXED OS is a 0 or 1
+1 NEW X
+2 SET X=$PIECE($GET(^XTV(8989.3,1,0)),"^",5)
+3 SET $PIECE(^XTV(8989.3,1,0),"^",5)=+X
+4 QUIT
+5 ;
DDGBL ;Convert any data in the 'GBL' node to match new DD.
+1 NEW DA,X,CNT
+2 SET DA=0
SET CNT=0
+3 FOR
SET DA=$ORDER(^%ZIS(1,DA))
if 'DA
QUIT
IF $DATA(^(DA,"GBL"))
Begin DoDot:1
+4 SET X=^%ZIS(1,DA,"GBL")
+5 if $LENGTH(X)
SET ^%ZIS(1,DA,"GBL")=1
SET CNT=CNT+1
+6 QUIT
End DoDot:1
+7 WRITE !,?5,CNT," 'GBL' nodes converted."
+8 QUIT
