source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUDDT.m@ 724

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1TIUDDT ; SLC/JM - XRef & Input Transform code for Template File #8927;8/23/2001
2 ;;1.0;TEXT INTEGRATION UTILITIES;**76,119,125**;Jun 20, 1997
3 ;
4 ; Input Transform functions return true if the field value is bad
5 ;
6BADTYPE(X,DA) ;Input Transform for .03 TYPE field
7 N BAD,NODE
8 S BAD=0,NODE=$$GETNODE()
9 I $P(NODE,U,4)="A" D
10 .I $$ISROOT(X) S BAD=$$BADROOT(DA,X)
11 .I X="P" S BAD=$$BADPROOT(DA,$P(NODE,U,6))
12 Q BAD
13 ;
14BADSTS(X,DA) ;Input Transform for .04 STATUS Field
15 N BAD,NODE,TYPE
16 S BAD=0
17 I X="A" D
18 .S NODE=$$GETNODE()
19 .S TYPE=$P(NODE,U,3)
20 .I $$ISROOT(TYPE) S BAD=$$BADROOT(DA,TYPE)
21 .I TYPE="P" S BAD=$$BADPROOT(DA,$P(NODE,U,6))
22 Q BAD
23 ;
24BADOWNER(X,DA) ;Input Transform for .06 PERSONAL OWNER Field
25 N BAD,NODE,ROOT,TYPE
26 S BAD=0
27 I +X D
28 .S NODE=$$GETNODE()
29 .I $P(NODE,U,3)="P",$P(NODE,U,4)="A" S BAD=$$BADPROOT(DA,X)
30 .I 'BAD D
31 ..F TYPE="R","TF","CF","OF" D Q:+BAD
32 ...S ROOT=$O(^TIU(8927,"AROOT",$$ROOTIDX(TYPE),0))
33 ...I +ROOT S BAD='$$PARENTOK(DA,ROOT)
34 Q BAD
35 ;
36BADITEM(X,DA1) ;Input Transform for ITEMS .02 ITEM Field
37 Q '$$PARENTOK(DA1,X)
38 ;
39 ; Field Cross Reference Routines
40 ;
41TYPESETR(X,DA) ; .03 TYPE Field "AROOT" and "AP" XRef Set Logic
42 N NODE,OWNER
43 S NODE=$$GETNODE()
44 I $P(NODE,U,4)="A" D
45 .I $$ISROOT(X),'$$BADROOT(DA,X) D
46 ..S ^TIU(8927,"AROOT",$$ROOTIDX(X),DA)=""
47 .I X="P" D
48 ..S OWNER=$P(NODE,U,6)
49 ..I '$$BADPROOT(DA,OWNER) D
50 ...S ^TIU(8927,"AROOT",OWNER,DA)=""
51 Q
52 ;
53TYPEKILR(X,DA) ; .03 TYPE Field "AROOT" and "AP" XRef Kill Logic
54 N NODE,OWNER
55 I $$ISROOT(X) K ^TIU(8927,"AROOT",$$ROOTIDX(X),DA)
56 I X="P" D
57 .S NODE=$$GETNODE()
58 .S OWNER=$P(NODE,U,6)
59 .I +OWNER K ^TIU(8927,"AROOT",OWNER,DA)
60 Q
61 ;
62STSSETR(X,DA) ; .04 STATUS Field "AROOT" and "AP" XRef Set Logic
63 N NODE,TYPE,OWNER
64 I X="A" D
65 .S NODE=$$GETNODE()
66 .S TYPE=$P(NODE,U,3)
67 .I $$ISROOT(TYPE),'$$BADROOT(DA,TYPE) D
68 ..S ^TIU(8927,"AROOT",$$ROOTIDX(TYPE),DA)=""
69 .I TYPE="P" D
70 ..S OWNER=$P(NODE,U,6)
71 ..I +OWNER,'$$BADPROOT(DA,OWNER) D
72 ...S ^TIU(8927,"AROOT",OWNER,DA)=""
73 Q
74 ;
75STSKILLR(X,DA) ; .04 STATUS Field "AROOT" XRef Kill Logic
76 N NODE,TYPE,OWNER
77 S NODE=$$GETNODE()
78 S TYPE=$P(NODE,U,3)
79 I $$ISROOT(TYPE) K ^TIU(8927,"AROOT",$$ROOTIDX(TYPE),DA)
80 I TYPE="P" D
81 .S OWNER=$P(NODE,U,6)
82 .I +OWNER K ^TIU(8927,"AROOT",OWNER,DA)
83 Q
84 ;
85OWNRSETR(X,DA) ; .06 OWNER Field "AROOT" XRef Set Logic
86 N NODE
87 I +X D
88 .S NODE=$$GETNODE()
89 .I $P(NODE,U,4)="A",$P(NODE,U,3)="P",'$$BADPROOT(DA,X) D
90 ..S ^TIU(8927,"AROOT",X,DA)=""
91 Q
92 ;
93OWNRKILR(X,DA) ; .06 OWNER Field "AROOT" XRef Kill Logic
94 I +X K ^TIU(8927,"AROOT",X,DA)
95 Q
96BADLINK(X,DA) ;Input Transform for .19 LINK field
97 N BAD,IDX
98 S BAD=0
99 S IDX=$O(^TIU(8927,"AL",X,0))
100 I +IDX,IDX'=DA S BAD=1
101 Q BAD
102 ;
103 ; Internal Routines
104 ;
105GETNODE() ; Sets NODE variable
106 Q $G(^TIU(8927,DA,0))
107 ;
108BADROOT(DA,TIUTYPE) ; Returns True if there is another root
109 N CURROOT,BAD
110 S BAD=0
111 S CURROOT=$O(^TIU(8927,"AROOT",$$ROOTIDX(TIUTYPE),0))
112 I +CURROOT,CURROOT'=DA S BAD=1
113 Q BAD
114 ;
115BADPROOT(DA,OWNER) ; Returns True if there is another personal root
116 N CURROOT,BAD
117 S BAD=0
118 I +OWNER D
119 .S CURROOT=$O(^TIU(8927,"AROOT",OWNER,0))
120 .I +CURROOT,CURROOT'=DA S BAD=1
121 Q BAD
122 ;
123PARENTOK(PARENT,ITEM) ; Returns True if ITEM is not in it's own parent list
124 N IDX,OK
125 S IDX=0,OK=1
126 F S IDX=$O(^TIU(8927,"AD",PARENT,IDX)) Q:'IDX D Q:'OK
127 .I IDX=ITEM S OK=0
128 .E S OK=$$PARENTOK(IDX,ITEM)
129 Q OK
130ISROOT(TYPE) ; Returns TRUE if TYPE is a valid root folder type
131 Q $S(TYPE="R":1,TYPE="TF":1,TYPE="CF":1,TYPE="OF":1,1:0)
132ROOTIDX(TYPE) ; Returns "AROOT" Index value for root types
133 Q $S(TYPE="R":"ROOT",TYPE="TF":"TITLES",TYPE="CF":"CONSULTS",TYPE="OF":"PROCEDURES",1:"")
Note: See TracBrowser for help on using the repository browser.