source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XU8P440.m@ 1073

Last change on this file since 1073 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.0 KB
RevLine 
[613]1XU8P440 ;ISF/RWF - Post-INIT for XU*8*440. ;01/17/2008
2 ;;8.0;KERNEL;**440**;Jul 10, 1995;Build 13
3 Q
4POST ;Post-INIT
5 D DD35,DD32,DDGBL,DD8989
6 D RELOAD^ZTMGRSET
7 Q
8DD35 ;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 ;
15DD32 ;
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 ;
26DD8989 ;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 ;
32DDGBL ;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
Note: See TracBrowser for help on using the repository browser.