source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTXX1.m@ 1672

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

WorldVistAEHR overlayed on FOIAVistA
File size: 7.5 KB
Line 
1DGPTXX1 ; COMPILED XREF FOR FILE #45 ; 12/27/07
2 ;
3 S DIKZK=2
4 S DIKZ(0)=$G(^DGPT(DA,0))
5 S X=$P(DIKZ(0),U,2)
6 I X'="" S L=+^DGPT(DA,0) I L>0 K ^DGPT("AAD",L,X,DA)
7 S X=$P(DIKZ(0),U,2)
8 I X'="" K ^DGPT("AF",$E(X,1,30),DA)
9 S X=$P(DIKZ(0),U,2)
10 I X'="" K ^DGPT("AADA",X,DA)
11 S X=$P(DIKZ(0),U,2)
12 I X'="" I $P(^DGPT(DA,0),U,4),$P(^(0),U) K ^DGPT("AFEE",$P(^DGPT(DA,0),U),$E(X,1,30),DA)
13 S X=$P(DIKZ(0),U,4)
14 I X'="" I $P(^DGPT(DA,0),U),$P(^(0),U,2) K ^DGPT("AFEE",$P(^DGPT(DA,0),U),$P(^DGPT(DA,0),U,2),DA)
15 S X=$P(DIKZ(0),U,5)
16 I X'="" D
17 .N DIK,DIV,DIU,DIN
18 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,101)):^(101),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" S DIH=$S($D(^DGPT(DIV(0),101)):^(101),1:""),DIV=X S $P(^(101),U,1)=DIV,DIH=45,DIG=20 D ^DICR:$O(^DD(DIH,DIG,1,0))>0
19 S DIKZ(0)=$G(^DGPT(DA,0))
20 S X=$P(DIKZ(0),U,6)
21 I X'="" K ^DGPT("AS",$E(X,1,30),DA)
22 S X=$P(DIKZ(0),U,10)
23 I X'="" K ^DGPT("AMT",$E(X,1,30),DA)
24 S X=$P(DIKZ(0),U,12)
25 I X'="" K ^DGPT("ACENSUS",$E(X,1,30),DA)
26 S X=$P(DIKZ(0),U,13)
27 I X'="" D
28 .N DIK,DIV,DIU,DIN
29 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,0)):^(0),1:"") S X=$P(Y(1),U,11),X=X S DIU=X K Y S X=DIV S X=1 S DIH=$S($D(^DGPT(DIV(0),0)):^(0),1:""),DIV=X S $P(^(0),U,11)=DIV,DIH=45,DIG=11 D ^DICR
30 S DIKZ(101)=$G(^DGPT(DA,101))
31 S X=$P(DIKZ(101),U,4)
32 I X'="" S %=+^DGPT(DA,0) I $D(^DPT(%,.3)) S %C=$P(^(.3),U,10) I %C S ^(.3)=$P(^(.3),U,1,9)_U_U_$P(^(.3),U,11,99) K ^DPT("ACB",%C,%),%,%C
33 S DIKZ("401P")=$G(^DGPT(DA,"401P"))
34 S X=$P(DIKZ("401P"),U,1)
35 I X'="" K ^DGPT(DA,"AP",X)
36 S X=$P(DIKZ("401P"),U,2)
37 I X'="" K ^DGPT(DA,"AP",X)
38 S X=$P(DIKZ("401P"),U,3)
39 I X'="" K ^DGPT(DA,"AP",X)
40 S X=$P(DIKZ("401P"),U,4)
41 I X'="" K ^DGPT(DA,"AP",X)
42 S X=$P(DIKZ("401P"),U,5)
43 I X'="" K ^DGPT(DA,"AP",X)
44 S DIKZ(70)=$G(^DGPT(DA,70))
45 S X=$P(DIKZ(70),U,1)
46 I X'="" K ^DGPT("ADS",$E(X,1,30),DA)
47 S X=$P(DIKZ(70),U,1)
48 I X'="" S %=$S($D(^DGPT(DA,"M",1,0)):^(0),1:""),%D=+$P(%,U,10),^(0)=$P(%_"^^^^^^^^^^",U,1,9)_U_X_U_$P(%,U,11,99) K ^DGPT(DA,"M","AM",%D,1),%,%D
49 S X=$P(DIKZ(70),U,1)
50 I X'="" S L=$P(^DGPT(DA,0),"^",2) I L?7N.E,$G(DIK)'="^DGPT(" S ^DGPT("AADA",L,DA)=""
51 S X=$P(DIKZ(70),U,2)
52 I X'="" I $D(^DGPT(DA,"M",1,0)) S $P(^(0),U,2)="",$P(^(0),U,16)=""
53 S X=$P(DIKZ(70),U,10)
54 I X'="" X ^DD(45,79,1,992,2)
55 S DIKZ(70)=$G(^DGPT(DA,70))
56 S X=$P(DIKZ(70),U,16)
57 I X'="" X ^DD(45,79.16,1,992,2)
58 S DIKZ(70)=$G(^DGPT(DA,70))
59 S X=$P(DIKZ(70),U,17)
60 I X'="" X ^DD(45,79.17,1,992,2)
61 S DIKZ(70)=$G(^DGPT(DA,70))
62 S X=$P(DIKZ(70),U,18)
63 I X'="" X ^DD(45,79.18,1,992,2)
64 S DIKZ(70)=$G(^DGPT(DA,70))
65 S X=$P(DIKZ(70),U,19)
66 I X'="" X ^DD(45,79.19,1,992,2)
67 S DIKZ(70)=$G(^DGPT(DA,70))
68 S X=$P(DIKZ(70),U,20)
69 I X'="" X ^DD(45,79.201,1,992,2)
70 S DIKZ(70)=$G(^DGPT(DA,70))
71 S X=$P(DIKZ(70),U,21)
72 I X'="" X ^DD(45,79.21,1,992,2)
73 S DIKZ(70)=$G(^DGPT(DA,70))
74 S X=$P(DIKZ(70),U,22)
75 I X'="" X ^DD(45,79.22,1,992,2)
76 S DIKZ(70)=$G(^DGPT(DA,70))
77 S X=$P(DIKZ(70),U,23)
78 I X'="" X ^DD(45,79.23,1,992,2)
79 S DIKZ(70)=$G(^DGPT(DA,70))
80 S X=$P(DIKZ(70),U,24)
81 I X'="" X ^DD(45,79.24,1,992,2)
82 S DIKZ(71)=$G(^DGPT(DA,71))
83 S X=$P(DIKZ(71),U,1)
84 I X'="" X ^DD(45,79.241,1,1,2)
85 S DIKZ(71)=$G(^DGPT(DA,71))
86 S X=$P(DIKZ(71),U,2)
87 I X'="" X ^DD(45,79.242,1,1,2)
88 S DIKZ(71)=$G(^DGPT(DA,71))
89 S X=$P(DIKZ(71),U,3)
90 I X'="" X ^DD(45,79.243,1,1,2)
91 S DIKZ(71)=$G(^DGPT(DA,71))
92 S X=$P(DIKZ(71),U,4)
93 I X'="" X ^DD(45,79.244,1,1,2)
94 S DIKZ(70)=$G(^DGPT(DA,70))
95 S X=$P(DIKZ(70),U,11)
96 I X'="" X ^DD(45,80,1,992,2)
97 S DIKZ(0)=$G(^DGPT(DA,0))
98 S X=$P(DIKZ(0),U,1)
99 I X'="" K ^DGPT("B",$E(X,1,30),DA)
100CR1 S DIXR=447
101 K X
102 S X(1)=$P(DIKZ(0),U,1)
103 S X(2)=$P(DIKZ(0),U,2)
104 S X(3)=$P(DIKZ(0),U,11)
105 S DIKZ(70)=$G(^DGPT(DA,70))
106 S X(4)=$P(DIKZ(70),U,10)
107 S X(5)=$P(DIKZ(70),U,1)
108 S X=$G(X(1))
109 I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
110 . K X1,X2 M X1=X,X2=X
111 . S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
112 . D KDGPT9D^DGPTDDCR(.X,.DA,"DXLS")
113CR2 S DIXR=448
114 K X
115 S DIKZ(0)=$G(^DGPT(DA,0))
116 S X(1)=$P(DIKZ(0),U,1)
117 S X(2)=$P(DIKZ(0),U,2)
118 S X(3)=$P(DIKZ(0),U,11)
119 S DIKZ(70)=$G(^DGPT(DA,70))
120 S X(4)=$P(DIKZ(70),U,11)
121 S X(5)=$P(DIKZ(70),U,1)
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),X2(5))=""
126 . D KDGPT9D^DGPTDDCR(.X,.DA,"PDX")
127CR3 S DIXR=449
128 K X
129 S DIKZ(0)=$G(^DGPT(DA,0))
130 S X(1)=$P(DIKZ(0),U,1)
131 S X(2)=$P(DIKZ(0),U,2)
132 S X(3)=$P(DIKZ(0),U,11)
133 S DIKZ(70)=$G(^DGPT(DA,70))
134 S X(4)=$P(DIKZ(70),U,16)
135 S X(5)=$P(DIKZ(70),U,1)
136 S X=$G(X(1))
137 I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
138 . K X1,X2 M X1=X,X2=X
139 . S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
140 . D KDGPT9D^DGPTDDCR(.X,.DA,"D SD1")
141CR4 S DIXR=450
142 K X
143 S DIKZ(0)=$G(^DGPT(DA,0))
144 S X(1)=$P(DIKZ(0),U,1)
145 S X(2)=$P(DIKZ(0),U,2)
146 S X(3)=$P(DIKZ(0),U,11)
147 S DIKZ(70)=$G(^DGPT(DA,70))
148 S X(4)=$P(DIKZ(70),U,17)
149 S X(5)=$P(DIKZ(70),U,1)
150 S X=$G(X(1))
151 I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
152 . K X1,X2 M X1=X,X2=X
153 . S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
154 . D KDGPT9D^DGPTDDCR(.X,.DA,"D SD2")
155CR5 S DIXR=451
156 K X
157 S DIKZ(0)=$G(^DGPT(DA,0))
158 S X(1)=$P(DIKZ(0),U,1)
159 S X(2)=$P(DIKZ(0),U,2)
160 S X(3)=$P(DIKZ(0),U,11)
161 S DIKZ(70)=$G(^DGPT(DA,70))
162 S X(4)=$P(DIKZ(70),U,18)
163 S X(5)=$P(DIKZ(70),U,1)
164 S X=$G(X(1))
165 I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
166 . K X1,X2 M X1=X,X2=X
167 . S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
168 . D KDGPT9D^DGPTDDCR(.X,.DA,"D SD3")
169CR6 S DIXR=452
170 K X
171 S DIKZ(0)=$G(^DGPT(DA,0))
172 S X(1)=$P(DIKZ(0),U,1)
173 S X(2)=$P(DIKZ(0),U,2)
174 S X(3)=$P(DIKZ(0),U,11)
175 S DIKZ(70)=$G(^DGPT(DA,70))
176 S X(4)=$P(DIKZ(70),U,19)
177 S X(5)=$P(DIKZ(70),U,1)
178 S X=$G(X(1))
179 I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
180 . K X1,X2 M X1=X,X2=X
181 . S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
182 . D KDGPT9D^DGPTDDCR(.X,.DA,"D SD4")
183CR7 S DIXR=453
184 K X
185 S DIKZ(0)=$G(^DGPT(DA,0))
186 S X(1)=$P(DIKZ(0),U,1)
187 S X(2)=$P(DIKZ(0),U,2)
188 S X(3)=$P(DIKZ(0),U,11)
189 S DIKZ(70)=$G(^DGPT(DA,70))
190 S X(4)=$P(DIKZ(70),U,20)
191 S X(5)=$P(DIKZ(70),U,1)
192 S X=$G(X(1))
193 I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
194 . K X1,X2 M X1=X,X2=X
195 . S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
196 . D KDGPT9D^DGPTDDCR(.X,.DA,"D SD5")
197CR8 S DIXR=454
198 K X
199 S DIKZ(0)=$G(^DGPT(DA,0))
200 S X(1)=$P(DIKZ(0),U,1)
201 S X(2)=$P(DIKZ(0),U,2)
202 S X(3)=$P(DIKZ(0),U,11)
203 S DIKZ(70)=$G(^DGPT(DA,70))
204 S X(4)=$P(DIKZ(70),U,21)
205 S X(5)=$P(DIKZ(70),U,1)
206 S X=$G(X(1))
207 I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
208 . K X1,X2 M X1=X,X2=X
209 . S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
210 . D KDGPT9D^DGPTDDCR(.X,.DA,"D SD6")
211CR9 S DIXR=455
212 K X
213 S DIKZ(0)=$G(^DGPT(DA,0))
214 S X(1)=$P(DIKZ(0),U,1)
215 S X(2)=$P(DIKZ(0),U,2)
216 S X(3)=$P(DIKZ(0),U,11)
217 S DIKZ(70)=$G(^DGPT(DA,70))
218 S X(4)=$P(DIKZ(70),U,22)
219 S X(5)=$P(DIKZ(70),U,1)
220 S X=$G(X(1))
221 I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
222 . K X1,X2 M X1=X,X2=X
223 . S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
224 . D KDGPT9D^DGPTDDCR(.X,.DA,"D SD7")
225CR10 S DIXR=456
226 K X
227 S DIKZ(0)=$G(^DGPT(DA,0))
228 S X(1)=$P(DIKZ(0),U,1)
229 S X(2)=$P(DIKZ(0),U,2)
230 S X(3)=$P(DIKZ(0),U,11)
231 S DIKZ(70)=$G(^DGPT(DA,70))
232 S X(4)=$P(DIKZ(70),U,23)
233 S X(5)=$P(DIKZ(70),U,1)
234 S X=$G(X(1))
235 I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
236 . K X1,X2 M X1=X,X2=X
237 . S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
238 . D KDGPT9D^DGPTDDCR(.X,.DA,"D SD8")
239CR11 S DIXR=457
240 K X
241 S DIKZ(0)=$G(^DGPT(DA,0))
242 S X(1)=$P(DIKZ(0),U,1)
243 S X(2)=$P(DIKZ(0),U,2)
244 S X(3)=$P(DIKZ(0),U,11)
245 S DIKZ(70)=$G(^DGPT(DA,70))
246 S X(4)=$P(DIKZ(70),U,24)
247 S X(5)=$P(DIKZ(70),U,1)
248 S X=$G(X(1))
249 I $G(X(1))]"",$G(X(2))]"",$G(X(3))]"",$G(X(4))]"" D
250 . K X1,X2 M X1=X,X2=X
251 . S:$D(DIKIL) (X2,X2(1),X2(2),X2(3),X2(4),X2(5))=""
252 . D KDGPT9D^DGPTDDCR(.X,.DA,"D SD9")
253CR12 S DIXR=458
254 K X
255END G ^DGPTXX2
Note: See TracBrowser for help on using the repository browser.