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/XPDIA2.m@ 1141

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

initial load of WorldVistAEHR

File size: 4.3 KB
RevLine 
[613]1XPDIA2 ;SFISC/RSD - Delete Options and cleanup pointers ;11/03/99 12:58
2 ;;8.0;KERNEL;**68,131**;Jul 10, 1995
3 Q
4OPT ;options
5 N XPDI,XPDJ,XPDK,XPDM,XPDX,X
6 ;XPDM=ien of the XMUSER option
7 S X=$O(^DIC(19,"B","XMUSER",0)),XPDM=$S(X:X,1:"@"),XPDX=0
8 ;loop thru all the options that are to be deleted
9 F S XPDX=$O(^TMP($J,"XPDEL",XPDX)) Q:'XPDX D
10 .;check that the following might reference this option, XPDX
11 .;file 19, menu item, 10
12 .S XPDI=0 F S XPDI=$O(^DIC(19,"AD",XPDX,XPDI)) Q:'XPDI D
13 ..S XPDJ=0 F S XPDJ=$O(^DIC(19,"AD",XPDX,XPDI,XPDJ)) Q:'XPDJ D
14 ...N XPDA S XPDA=XPDJ,XPDA(1)=XPDI
15 ...D DIK("^DIC(19,"_XPDI_",10,",.XPDA,DUZ)
16 .;file 19.081, field .01
17 .S XPDI=0 F S XPDI=$O(^XUSEC(19,"B",XPDX,XPDI)) Q:'XPDI D DIK("^XUSEC(19,",XPDI,DUZ)
18 .;file 19.2, field .01
19 .S XPDI=0 F S XPDI=$O(^DIC(19.2,"B",XPDX,XPDI)) Q:'XPDI D DIK("^DIC(19.2,",XPDI,DUZ)
20 .;file 200, secondary menu item, 203
21 .S XPDI=0 F S XPDI=$O(^VA(200,"AD",XPDX,XPDI)) Q:'XPDI D
22 ..S XPDJ=0 F S XPDJ=$O(^VA(200,"AD",XPDX,XPDI,XPDJ)) Q:'XPDJ D
23 ...N XPDA S XPDA=XPDJ,XPDA(1)=XPDI
24 ...D DIK("^VA(200,"_XPDI_",203,",.XPDA,DUZ)
25 .Q
26 ;
27 ;loop thru New Person file
28 S XPDI=0 F S XPDI=$O(^VA(200,XPDI)) Q:'XPDI D
29 .K XPDK S X="XPDK(200,"""_XPDI_","")"
30 .I $D(^VA(200,XPDI,201)) S XPDX=^(201) D
31 ..;check primary option field 201
32 ..S:$D(^TMP($J,"XPDEL",+XPDX)) @X@(201)=XPDM
33 ..;check primary window field 201.1
34 ..S:$D(^TMP($J,"XPDEL",+$P(XPDX,U,2))) @X@(201.1)="@"
35 .;check last option accessed field 202.1
36 .I $D(^VA(200,XPDI,202.1)),$D(^TMP($J,"XPDEL",+^(202.1))) S @X@(202.1)="@"
37 .D:$D(XPDK) DIE(.XPDK,DUZ)
38 .;loop thru delegated options field 19.5, this multiple is dinumed
39 .S XPDJ=0 F S XPDJ=$O(^VA(200,XPDI,19.5,XPDJ)) Q:'XPDJ D:$D(^TMP($J,"XPDEL",XPDJ))
40 ..N XPDA S XPDA=XPDJ,XPDA(1)=XPDI
41 ..D DIK("^VA(200,"_XPDI_",19.5,",.XPDA,DUZ)
42 .Q
43 ;
44 ;loop thru Kernel Site Parameter file
45 S XPDI=0 F S XPDI=$O(^XTV(8989.3,XPDI)) Q:'XPDI D
46 .;loop thru alpha/beta test options field 33, node ABOPT, multiple is dinumed
47 .S XPDJ=0 F S XPDJ=$O(^XTV(8989.3,XPDI,"ABOPT",XPDJ)) Q:'XPDJ D:$D(^TMP($J,"XPDEL",XPDJ))
48 ..N XPDA S XPDA=XPDJ,XPDA(1)=XPDI
49 ..D DIK("^XTV(8989.3,"_XPDI_",""ABOPT"",",.XPDA,DUZ)
50 .;loop thru option to audit field 19.1, node 19.1
51 .S XPDJ=0 F S XPDJ=$O(^XTV(8989.3,XPDI,19.1,"B",XPDJ)) Q:'XPDJ D:$D(^TMP($J,"XPDEL",XPDJ))
52 ..N XPDA S XPDK=$O(^XTV(8989.3,XPDI,19.1,"B",XPDJ,0)),XPDA=XPDK,XPDA(1)=XPDI
53 ..D DIK("^XTV(8989.3,"_XPDI_",19.1,",.XPDA,DUZ)
54 .Q
55 ;
56 ;loop thru Device File and check primary option field 201
57 S XPDI=0 F S XPDI=$O(^%ZIS(1,XPDI)) Q:'XPDI D:$D(^TMP($J,"XPDEL",+$G(^(XPDI,201))))
58 .K XPDK S XPDK(3.5,XPDI_",",201)="@" D DIE(.XPDK,DUZ)
59 Q
60 ;
61PRO ;protocols
62 N XPDI,XPDJ,XPDK,XPDX,X
63 S XPDX=0
64 ;loop thru all the protocols that are to be deleted
65 F S XPDX=$O(^TMP($J,"XPDEL",XPDX)) Q:'XPDX D
66 .;check that the following might reference this protocol, XPDX
67 .;file 101, menu item, 10
68 .S XPDI=0 F S XPDI=$O(^ORD(101,"AD",XPDX,XPDI)) Q:'XPDI D
69 ..S XPDJ=0 F S XPDJ=$O(^ORD(101,"AD",XPDX,XPDI,XPDJ)) Q:'XPDJ D
70 ...N XPDA S XPDA=XPDJ,XPDA(1)=XPDI
71 ...D DIK("^ORD(101,"_XPDI_",10,",.XPDA,DUZ)
72 .;file 101, subscriber, 775
73 .S XPDI=0 F S XPDI=$O(^ORD(101,"AB",XPDX,XPDI)) Q:'XPDI D
74 ..S XPDJ=0 F S XPDJ=$O(^ORD(101,"AB",XPDX,XPDI,XPDJ)) Q:'XPDJ D
75 ...N XPDA S XPDA=XPDJ,XPDA(1)=XPDI
76 ...D DIK("^ORD(101,"_XPDI_",775,",.XPDA,DUZ)
77 .;file 123.1, REQUEST ACTION TYPE, field 2
78 .S XPDI=0 F S XPDI=$O(^GMR(123.1,"C",XPDX,XPDI)) Q:'XPDI D
79 ..S X=$G(^GMR(123.1,XPDI,0)) Q:X=""
80 ..K XPDK S XPDK(123.1,XPDI_",",2)="@"
81 ..D DIE(.XPDK,DUZ)
82 .Q
83 ;
84 ;loop thru New Person file
85 S XPDI=0 F S XPDI=$O(^VA(200,XPDI)) Q:'XPDI D
86 .K XPDK S X="XPDK(200,"""_XPDI_","")"
87 .I $D(^VA(200,XPDI,100.1)) S XPDX=^(100.1) D
88 ..;check PRIMARY OE/RR MENU, field 100.11
89 ..S:$D(^TMP($J,"XPDEL",+XPDX)) @X@(100.11)="@"
90 ..;check PRIMARY ORDER MENU, field 100.12
91 ..S:$D(^TMP($J,"XPDEL",+$P(XPDX,U,2))) @X@(100.12)="@"
92 .I $D(^VA(200,XPDI,100.2)) S XPDX=^(100.2) D
93 ..;check DEFAULT RESULT REPORTING MENU, field 100.23
94 ..S:$D(^TMP($J,"XPDEL",+$P(XPDX,U,3))) @X@(100.23)="@"
95 ..;check PRIMARY PROFILE MENU, field 100.24
96 ..S:$D(^TMP($J,"XPDEL",+$P(XPDX,U,4))) @X@(100.24)="@"
97 .D:$D(XPDK) DIE(.XPDK,DUZ)
98 Q
99 ;
100DIK(DIK,DA,DUZ) ;delete
101 S DUZ(0)="@" D ^DIK
102 Q
103DIE(XPD,DUZ) ;
104 ;XPD(file,DA_",",field)=XMUSER option or '@' to delete
105 S DUZ(0)="@"
106 D FILE^DIE("","XPD")
107 Q
Note: See TracBrowser for help on using the repository browser.