| 1 | XU8P440 ;ISF/RWF - Post-INIT for XU*8*440. ;01/17/2008
|
|---|
| 2 | ;;8.0;KERNEL;**440**;Jul 10, 1995;Build 13
|
|---|
| 3 | Q
|
|---|
| 4 | POST ;Post-INIT
|
|---|
| 5 | D DD35,DD32,DDGBL,DD8989
|
|---|
| 6 | D RELOAD^ZTMGRSET
|
|---|
| 7 | Q
|
|---|
| 8 | DD35 ;Remove old HUNT GROUP field #29. OLDXY is in p463
|
|---|
| 9 | N %,DA,DIK
|
|---|
| 10 | I $E($G(^DD(3.5,29,0)),1)="*" D
|
|---|
| 11 | . 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)=""
|
|---|
| 12 | . S DIK="^DD(3.5,",DA=29,DA(1)=3.5 D ^DIK
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | DD32 ;
|
|---|
| 16 | N DA,DIK
|
|---|
| 17 | I $E($G(^DD(3.2,408,0)),1)="*" D
|
|---|
| 18 | . F DA=0:0 S DA=$O(^%ZIS(2,DA)) Q:'DA K ^%ZIS(2,DA,408),^%ZIS(2,DA,409)
|
|---|
| 19 | . S DIK="^DD(3.2,",DA=408,DA(1)=3.2 D ^DIK
|
|---|
| 20 | . Q
|
|---|
| 21 | I $E($G(^DD(3.2,409,0)),1)="*" D
|
|---|
| 22 | . S DIK="^DD(3.2,",DA=409,DA(1)=3.2 D ^DIK
|
|---|
| 23 | . Q
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | DD8989 ;See that MIXED OS is a 0 or 1
|
|---|
| 27 | N X
|
|---|
| 28 | S X=$P($G(^XTV(8989.3,1,0)),"^",5)
|
|---|
| 29 | S $P(^XTV(8989.3,1,0),"^",5)=+X
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | DDGBL ;Convert any data in the 'GBL' node to match new DD.
|
|---|
| 33 | N DA,X,CNT
|
|---|
| 34 | S DA=0,CNT=0
|
|---|
| 35 | F S DA=$O(^%ZIS(1,DA)) Q:'DA I $D(^(DA,"GBL")) D
|
|---|
| 36 | . S X=^%ZIS(1,DA,"GBL")
|
|---|
| 37 | . S:$L(X) ^%ZIS(1,DA,"GBL")=1,CNT=CNT+1
|
|---|
| 38 | . Q
|
|---|
| 39 | W !,?5,CNT," 'GBL' nodes converted."
|
|---|
| 40 | Q
|
|---|
