source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUXRC2.m@ 613

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

initial load of WorldVistAEHR
File size: 7.9 KB
Line 
1TIUXRC2 ; COMPILED XREF FOR FILE #8925 ; 11/08/09
2 ;
3END G ^TIUXRC2
4 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,3),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"AVSIT",+$P(^TIU(8925,+DA,0),U,3),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),DA)
5 S X=$P(DIKZ(13),U,1)
6 I X'="" I +$P($G(^TIU(8925,+DA,0)),U,4),+$P($G(^TIU(8925,+DA,0)),U,2),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ADCPT",+$P(^TIU(8925,+DA,0),U,2),+$P(^TIU(8925,+DA,0),U,4),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),DA)
7 S X=$P(DIKZ(13),U,1)
8 I X'="" K ^TIU(8925,"D",$E(X,1,30),DA)
9 S X=$P(DIKZ(13),U,1)
10 I X'="" I +$P(^TIU(8925,+DA,0),U),+$P($G(^TIU(8925,+DA,0)),U,2) K ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),+$$CLINDOC^TIULC1(+$P(^TIU(8925,+DA,0),U),+DA),(9999999-X),DA)
11 S X=$P(DIKZ(13),U,1)
12 I X'="" I +$P(^TIU(8925,+DA,0),U),+$P($G(^TIU(8925,+DA,0)),U,2) K ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),38,(9999999-X),DA)
13 S X=$P(DIKZ(13),U,1)
14 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,12)),U,5),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ALOC",+$P(^TIU(8925,+DA,12),U,5),+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-X),+DA)
15 S X=$P(DIKZ(13),U,1)
16 I X'="" D KACLPT^TIUDD01(1301,X)
17 S X=$P(DIKZ(13),U,1)
18 I X'="" D KACLAU^TIUDD01(1301,X),KACLAU1^TIUDD01(1301,X)
19 S X=$P(DIKZ(13),U,1)
20 I X'="" D KACLEC^TIUDD01(1301,X)
21 S X=$P(DIKZ(13),U,1)
22 I X'="" D KACLSB^TIUDD01(1301,X)
23 S X=$P(DIKZ(13),U,2)
24 I X'="" K ^TIU(8925,"TC",$E(X,1,30),DA)
25 S X=$P(DIKZ(13),U,2)
26 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ATC",+X,+$P($G(^TIU(8925,+DA,0)),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
27 S X=$P(DIKZ(13),U,2)
28 I X'="" D KACLAU1^TIUDD01(1302,X)
29 S X=$P(DIKZ(13),U,4)
30 I X'="" K ^TIU(8925,"E",$E(X,1,30),DA)
31 S DIKZ(14)=$G(^TIU(8925,DA,14))
32 S X=$P(DIKZ(14),U,2)
33 I X'="" K ^TIU(8925,"TS",$E(X,1,30),DA)
34 S X=$P(DIKZ(14),U,2)
35 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ATS",+X,+$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
36 S X=$P(DIKZ(14),U,4)
37 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ASVC",+X,+$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
38 S X=$P(DIKZ(14),U,4)
39 I X'="" K ^TIU(8925,"SVC",$E(X,1,30),DA)
40 S X=$P(DIKZ(14),U,5)
41 I X'="" K ^TIU(8925,"G",$E(X,1,30),DA)
42 S DIKZ(15)=$G(^TIU(8925,DA,15))
43 S X=$P(DIKZ(15),U,1)
44 I X'="" I +$P($G(^TIU(8925,+DA,12)),U,5) K ^TIU(8925,"ALOCP",+$P($G(^TIU(8925,+DA,12)),U,5),+X,+DA)
45 S X=$P(DIKZ(15),U,1)
46 I X'="" I +$P($G(^TIU(8925,+DA,0)),U,2) K ^TIU(8925,"APTP",+$P($G(^TIU(8925,+DA,0)),U,2),+X,+DA)
47 S X=$P(DIKZ(15),U,1)
48 I X'="" I +$P($G(^TIU(8925,+DA,12)),U,2) K ^TIU(8925,"AAUP",+$P($G(^TIU(8925,+DA,12)),U,2),+X,+DA)
49 S X=$P(DIKZ(15),U,1)
50 I X'="" D KACLPT^TIUDD01(1501,X)
51 S X=$P(DIKZ(15),U,1)
52 I X'="" D KACLEC^TIUDD01(1501,X)
53 S X=$P(DIKZ(15),U,1)
54 I X'="" D SACLAU^TIUDD0(1501,X),SACLAU1^TIUDD0(1501,X)
55 S X=$P(DIKZ(15),U,2)
56 I X'="" D KACLSB^TIUDD01(1502,X)
57 S X=$P(DIKZ(15),U,7)
58 I X'="" D SACLEC^TIUDD0(1507,X)
59 S X=$P(DIKZ(15),U,7)
60 I X'="" D KACLPT^TIUDD01(1507,X)
61 S DIKZ(17)=$G(^TIU(8925,DA,17))
62 S X=$P(DIKZ(17),U,1)
63 I X'="" I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,0)),U,5),+$P($G(^TIU(8925,+DA,13)),U) D ASUBK^TIUDD($G(X),+$G(^TIU(8925,+DA,0)),+$P(^TIU(8925,+DA,0),U,5),(9999999-+$G(^TIU(8925,+DA,13))),DA)
64 S DIKZ(21)=$G(^TIU(8925,DA,21))
65 S X=$P(DIKZ(21),U,1)
66 I X'="" K ^TIU(8925,"GDAD",$E(X,1,30),DA)
67 S DIKZ(150)=$G(^TIU(8925,DA,150))
68 S X=$P(DIKZ(150),U,1)
69 I X'="" K ^TIU(8925,"VID",$E(X,1,30),DA)
70 S X=$P(DIKZ(0),U,1)
71 I X'="" K ^TIU(8925,"B",$E(X,1,30),DA)
72 S X=$P(DIKZ(0),U,1)
73 I X'="" I +$P(^TIU(8925,+DA,0),U,2),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"APT",+$P(^TIU(8925,+DA,0),U,2),+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-$P(^TIU(8925,+DA,13),U)),DA)
74 S X=$P(DIKZ(0),U,1)
75 I X'="" I +$P($G(^TIU(8925,+DA,12)),U,2),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"AAU",+$P($G(^TIU(8925,+DA,12)),U,2),+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
76 S X=$P(DIKZ(0),U,1)
77 I X'="" I +$P($G(^TIU(8925,+DA,12)),U,8),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ASUP",+$P($G(^TIU(8925,+DA,12)),U,8),+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
78 S X=$P(DIKZ(0),U,1)
79 I X'="" I +$P($G(^TIU(8925,+DA,0)),U,2),+$P($G(^(0)),U,3) K ^TIU(8925,"AV",+$P(^TIU(8925,+DA,0),U,2),+X,+$P(^TIU(8925,+DA,0),U,3),+DA)
80 S X=$P(DIKZ(0),U,1)
81 I X'="" I +$P($G(^TIU(8925,+DA,14)),U,2),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ATS",+$P($G(^TIU(8925,+DA,14)),U,2),+X,+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
82 S X=$P(DIKZ(0),U,1)
83 I X'="" I +$P($G(^TIU(8925,+DA,13)),U,2),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ATC",+$P($G(^TIU(8925,+DA,13)),U,2),+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
84 S X=$P(DIKZ(0),U,1)
85 I X'="" I +$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ALL","ANY",+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
86 S X=$P(DIKZ(0),U,1)
87 I X'="" I $L($P(^TIU(8925,+DA,0),U,2)),(+$P(^(0),U,3)>0) K ^TIU(8925,"AA",+$P(^(0),U,2),+X,(9999999-$P(+^AUPNVSIT(+$P(^TIU(8925,+DA,0),U,3),0),".")),DA)
88 S X=$P(DIKZ(0),U,1)
89 I X'="" I $L($P($G(^TIU(8925,+DA,17)),U)),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) D ASUBK^TIUDD($P($G(^TIU(8925,+DA,17)),U),+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-+$G(^TIU(8925,+DA,13))),DA)
90 S X=$P(DIKZ(0),U,1)
91 I X'="" I +$P($G(^TIU(8925,+DA,14)),U,4),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ASVC",+$P($G(^TIU(8925,+DA,14)),U,4),+X,+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
92 S X=$P(DIKZ(0),U,1)
93 I X'="" I $L($P(^TIU(8925,+DA,0),U)),(+$P(^(0),U,3)>0) K ^TIU(8925,"AE",+$P($G(^TIU(8925,+DA,0)),U,2),(9999999-$P(+^AUPNVSIT(+$P(^TIU(8925,+DA,0),U,3),0),".")),+X,+DA)
94 S X=$P(DIKZ(0),U,1)
95 I X'="" I +$P($G(^TIU(8925,+DA,12)),U,5),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"ALOC",+$P($G(^TIU(8925,+DA,12)),U,5),+X,+$P($G(^TIU(8925,+DA,0)),U,5),(9999999-$P($G(^TIU(8925,+DA,13)),U)),DA)
96 S X=$P(DIKZ(0),U,1)
97 I X'="" I +$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5),+$O(^TIU(8925.9,"B",+DA,0)) D APRBK^TIUDD(+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-+$G(^TIU(8925,+DA,13))),DA)
98 S X=$P(DIKZ(0),U,1)
99 I X'="" I +$P(^TIU(8925,+DA,0),U,3),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) K ^TIU(8925,"AVSIT",+$P(^TIU(8925,+DA,0),U,3),+X,+$P(^TIU(8925,+DA,0),U,5),(9999999-$P(^TIU(8925,+DA,13),U)),DA)
100 S X=$P(DIKZ(0),U,1)
101 I X'="" I +$P(^TIU(8925,+DA,0),U,2),+$P($G(^TIU(8925,+DA,13)),U) K ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),+$$CLINDOC^TIULC1(+X,+DA),(9999999-$P(^TIU(8925,+DA,13),U)),DA)
102 S X=$P(DIKZ(0),U,1)
103 I X'="" I +$P(^TIU(8925,+DA,0),U,2),+$P($G(^TIU(8925,+DA,13)),U) K ^TIU(8925,"APTCL",+$P(^TIU(8925,+DA,0),U,2),38,(9999999-$P(^TIU(8925,+DA,13),U)),DA)
104 S X=$P(DIKZ(0),U,1)
105 I X'="" D KACLPT^TIUDD01(.01,X)
106 S X=$P(DIKZ(0),U,1)
107 I X'="" D KACLAU^TIUDD01(.01,X),KACLAU1^TIUDD01(.01,X)
108 S X=$P(DIKZ(0),U,1)
109 I X'="" D KACLEC^TIUDD01(.01,X)
110 S X=$P(DIKZ(0),U,1)
111 I X'="" D KACLSB^TIUDD01(.01,X)
112 S X=$P(DIKZ(0),U,1)
113 I X'="" D KAPTLD^TIUDD01(.01,X)
114CR1 S DIXR=247
115 K X
116 S X(1)=$P(DIKZ(12),U,12)
117 S X(2)=$P(DIKZ(0),U,1)
118 S X(3)=$P(DIKZ(0),U,5)
119 S X=$P(DIKZ(13),U,1)
120 I $G(X)]"" S X=9999999-X
121 S:$D(X)#2 X(4)=X
122 S X=$G(X(1))
123 I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
124 . K X1,X2 M X1=X,X2=X
125 . S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4))=""
126 . K ^TIU(8925,"ADIV",X(1),X(2),X(3),X(4),DA)
127CR2 S DIXR=413
128 K X
129 S DIKZ(12)=$G(^TIU(8925,DA,12))
130 S X(1)=$P(DIKZ(12),U,7)
131 S X=$G(X(1))
132 I $G(X(1))]"" D
133 . K X1,X2 M X1=X,X2=X
134 . S:$D(DIKIL) (X2,X2(1))=""
135 . K ^TIU(8925,"VS",X,DA)
136CR3 K X
137END Q
Note: See TracBrowser for help on using the repository browser.