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/XUINPCH.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: 3.8 KB
RevLine 
[613]1XUINPCH ;SF/RWF - RE-INDEX NEW X-REF ON FILE 200 ;01/13/99 09:40
2 ;;8.0;KERNEL;**20,36,49,63,65,69,96,91,111**;Feb. 9, 1996
3 Q
4POST1 ;Post init for patch XU*8*20 to reindex new X-ref on file 200.
5 N XU,DA,DIK
6 F XU=0:0 S XU=$O(^VA(200,XU)) Q:XU'>0 I $D(^VA(200,XU,203,0)) D
7 . S DA(1)=XU,DIK="^VA(200,"_XU_",203,",DIK(1)=".01^4"
8 . D ENALL^DIK
9 . Q
10 Q
11POST14 ;Post INIT for patch XU*8*14 to seed the E-sig last changed date.
12 N DA,%,%H,LT S DA=.5,%H=$H,LT=$$KSP^XUPARAM("LIFETIME")
13 F S DA=$O(^VA(200,DA)) Q:DA'>0 S %=$G(^VA(200,DA,20)) I $L(%) D
14 . Q:'$L($P(%,U,4))!$P(%,U,1)
15 . S $P(^VA(200,DA,20),U,1)=+$$HADD^XLFDT(%H,($R(LT)+30),0,0,0)
16 . Q
17 Q
18 ;
19POST36 ;Post INIT for patch XU*8*36
20 N I,X
21 ;Cleanup some old data in file 4.
22 F I=0:0 S I=$O(^DIC(4,I)) Q:I'>0 I $D(^DIC(4,I,1,"B"))>2 K ^DIC(4,I,1,"B")
23 ;See that we have the current ID nodes for file 200
24 F I=1,2,3 S X=$T(ID200+I) I $P(X,";",3)]"" S ^DD(200,0,"ID",$P(X,";",3))=$P(X,";",4,99)
25 Q
26ID200 ;;
27 ;;1;D EN^DDIOL(" "_$P(^(0),U,2),"","?0")
28 ;;28;D:$D(^(5)) EN^DDIOL(" "_$P(^(5),U,2),"","?0")
29 ;;W8;D:$P(^(0),U,9) EN^DDIOL(" "_$$EXTERNAL^DILFD(200,8,"",$P(^(0),U,9)),"","?0")
30 ;
31POST49 ;Post INIT for patch XU*8*49
32 N I,X
33 ;See that we have the current ID nodes for file 3.2 and 3.5
34 F I=1:1:4 S X=$T(ID49+I) I $P(X,";",3)]"" S ^DD($P(X,";",3),0,"ID",$P(X,";",4))=$P(X,";",5,99)
35 Q
36ID49 ;;
37 ;;3.2;W99;N % S %=$P($G(^(9)),U,1) D:$L(%) EN^DDIOL(" "_%,"",$S($S($X>30:$X,1:30)+$L(%)>76:"!?8",1:"?30"))
38 ;;3.5;.02;N % S %=$P($G(^(1)),U) D:$L(%) EN^DDIOL(" "_%,"",$S($X+$L(%)>76:"!?"_(77-$L(%)),1:"?0"))
39 ;;3.5;1;D EN^DDIOL(" "_$P(^(0),U,2),"","?0")
40 ;;3.5;1.9;D EN^DDIOL(" "_$P(^(0),U,9),"","?0")
41 ;
42POST63 ;Post INIT for patch xu*8*63
43 ;Move taskman screens to error message file.
44 N X1,X2,X3,ZDF,ZDA,DIE,DR,DA S X1=""
45 F X3=1:1 S X1=$O(^%ZTSCH("ES",X1)) Q:X1="" D
46 . S X2=$O(^%ZTER(2,"B",X1,0)) I X2 S DA=X2,DR=".03////2",DIE="3.076" D ^DIE Q
47 . S ZDA="?+1,",ZDF(3.076,ZDA,.01)="LOCAL_"_X3,ZDF(3.076,ZDA,.02)="L",ZDF(3.076,ZDA,.03)=2,ZDF(3.076,ZDA,2)=X1
48 . D UPDATE^DIE("","ZDF","") K ZDF Q
49 . Q
50 K ^%ZTSCH("ES")
51 Q
52 ;
53POST65 ;Post INIT for patch XU*8*65
54 ;Remove extra CPU field from sign-on file.
55 I $D(^DD(3.081,60,0)) S DIK="^DD(3.081,",DA=60,DA(1)=3.081 D ^DIK
56 Q
57POST69 ;Post init for patch XU*8*69
58 ;Remove extra node from Option file set by patch 49
59 N DA,DIK,DF,X,Y,Z,N
60 K ^DD(19,.01,7.5),^DD(19,.01,4)
61 ;Delete extra data from the device file
62 F DF=0:0 S DF=$O(^%ZIS(1,DF)) Q:DF'>0 S X=$G(^%ZIS(1,DF,91)),Y=+$G(^("SUBTYPE")) D
63 . S Z=$G(^%ZIS(2,Y,1)),N=""
64 . I X>0,$P(X,U,1,4)'=$P(Z,U,1,4) S:X>0 N=+X S:$P(X,U,3)]"" $P(N,U,3)=$P(X,U,3)
65 . K ^%ZIS(1,DF,91) S:N]"" ^(91)=N
66 . Q
67 ;Remove fields 10 and 12 from file 3.5
68 F DA=10,12 S DIK="^DD(3.5,",DA(1)=3.5 D ^DIK
69 ;Remove X-ref from SUBTYPE field.
70 I $D(^DD(3.5,3,1,1,0)) S DIK="^DD(3.5,3,1,",DA=1,DA(1)=3,DA(2)=3.5 D ^DIK
71 ;Cleanup Resource file
72 K ^%ZIS(3.54) ;Been setting wrong global
73 S DA=" "
74 F S DA=$O(^%ZISL(3.54,DA),-1) Q:DA'>0 S Z=$P(^%ZISL(3.54,DA,0),U) D
75 . I $D(^%ZISL(3.54,DA,1,0))#2,$P(^(0),U,2)'="3.542" S $P(^(0),U,2)=3.542
76 . S Z(1)=$O(^%ZISL(3.54,"B",Z,0)) Q:Z(1)'<DA D
77 . . S DIK="^%ZISL(3.54," D ^DIK
78 ;See that the FF field has data.
79 S DA=0
80 F S DA=$O(^%ZIS(2,DA)) Q:DA'>0 I "PC"[$E(^(DA,0)) S Z=$G(^%ZIS(2,DA,1)) I $P(Z,U,2)="" S $P(^%ZIS(2,DA,1),U,2)="#" W !,DA
81 Q
82 ;
83POST91 ;Fix SCR on file 3.5 for printing.
84 ;;I 1 Q:$G(D)'="LSYN" Q:'$D(^%ZOSF("VOL")) I $P(^%ZIS(1,Y,0),U,9)=^%ZOSF("VOL")!($P(^%ZIS(1,Y,0),U,9)="")
85 S ^DD(3.5,0,"SCR")=$P($T(POST91+1),";;",2,99)
86 Q
87POST96 ;Run the new X-ref
88 N IX,DIK,DA
89 F DA=0:0 S DA=$O(^DIC(4,DA)) Q:DA'>0 I '$D(^AUTTLOC(DA,0)) D
90 . S DIK="^DIC(4,",DIK(1)=".01" D EN1^DIK
91 . Q
92 Q
93POST111 ;Delete file 49 subfiles that point to file 3.
94 N DIU
95 I $G(^DD(49.01,0))["*" S DIU=49.01,DIU(0)="SD" D EN^DIU2
96 I $G(^DD(49.02,0))["*" S DIU=49.02,DIU(0)="SD" D EN^DIU2
97 Q
Note: See TracBrowser for help on using the repository browser.