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

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

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