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

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

WorldVistAEHR overlayed on FOIAVistA
File size: 4.5 KB
Line 
1DGPTXX4 ; COMPILED XREF FOR FILE #45.02 ; 12/27/07
2 ;
3 S DA=0
4A1 ;
5 I $D(DIKILL) K DIKLM S:DIKM1=1 DIKLM=1 G @DIKM1
60 ;
7A S DA=$O(^DGPT(DA(1),"M",DA)) I DA'>0 S DA=0 G END
81 ;
9 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
10 S X=$P(DIKZ(0),U,2)
11 I X'="" D
12 .N DIK,DIV,DIU,DIN
13 .K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGPT(D0,"M",D1,0)):^(0),1:"") S X=$P(Y(1),U,16),X=X S DIU=X K Y S X="" X ^DD(45.02,2,1,1,2.4)
14 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
15 S X=$P(DIKZ(0),U,5)
16 I X'="" K ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)
17 S X=$P(DIKZ(0),U,5)
18 I X'="" X ^DD(45.02,5,1,992,2)
19 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
20 S X=$P(DIKZ(0),U,6)
21 I X'="" K ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)
22 S X=$P(DIKZ(0),U,6)
23 I X'="" X ^DD(45.02,6,1,992,2)
24 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
25 S X=$P(DIKZ(0),U,7)
26 I X'="" K ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)
27 S X=$P(DIKZ(0),U,7)
28 I X'="" X ^DD(45.02,7,1,992,2)
29 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
30 S X=$P(DIKZ(0),U,8)
31 I X'="" K ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)
32 S X=$P(DIKZ(0),U,8)
33 I X'="" X ^DD(45.02,8,1,992,2)
34 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
35 S X=$P(DIKZ(0),U,9)
36 I X'="" K ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)
37 S X=$P(DIKZ(0),U,9)
38 I X'="" X ^DD(45.02,9,1,992,2)
39 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
40 S X=$P(DIKZ(0),U,10)
41 I X'="" K ^DGPT(DA(1),"M","AM",$E(X,1,30),DA)
42 S X=$P(DIKZ(0),U,11)
43 I X'="" K ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)
44 S X=$P(DIKZ(0),U,11)
45 I X'="" X ^DD(45.02,11,1,992,2)
46 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
47 S X=$P(DIKZ(0),U,12)
48 I X'="" K ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)
49 S X=$P(DIKZ(0),U,12)
50 I X'="" X ^DD(45.02,12,1,992,2)
51 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
52 S X=$P(DIKZ(0),U,13)
53 I X'="" K ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)
54 S X=$P(DIKZ(0),U,13)
55 I X'="" X ^DD(45.02,13,1,992,2)
56 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
57 S X=$P(DIKZ(0),U,14)
58 I X'="" K ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)
59 S X=$P(DIKZ(0),U,14)
60 I X'="" X ^DD(45.02,14,1,992,2)
61 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
62 S X=$P(DIKZ(0),U,15)
63 I X'="" K ^DGPT(DA(1),"M","AC",$E(X,1,30),DA)
64 S X=$P(DIKZ(0),U,15)
65 I X'="" X ^DD(45.02,15,1,992,2)
66CR1 S DIXR=462
67 K X
68 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
69 S X(1)=$P(DIKZ(0),U,10)
70 S X(2)=$P(DIKZ(0),U,5)
71 S X=$G(X(1))
72 I $G(X(1))]"",$G(X(2))]"" D
73 . K X1,X2 M X1=X,X2=X
74 . S:$D(DIKIL) (X2,X2(1),X2(2))=""
75 . D KDGPT9M^DGPTDDCR(.X,.DA,"M ICD1")
76CR2 S DIXR=463
77 K X
78 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
79 S X(1)=$P(DIKZ(0),U,10)
80 S X(2)=$P(DIKZ(0),U,6)
81 S X=$G(X(1))
82 I $G(X(1))]"",$G(X(2))]"" D
83 . K X1,X2 M X1=X,X2=X
84 . S:$D(DIKIL) (X2,X2(1),X2(2))=""
85 . D KDGPT9M^DGPTDDCR(.X,.DA,"M ICD2")
86CR3 S DIXR=464
87 K X
88 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
89 S X(1)=$P(DIKZ(0),U,10)
90 S X(2)=$P(DIKZ(0),U,7)
91 S X=$G(X(1))
92 I $G(X(1))]"",$G(X(2))]"" D
93 . K X1,X2 M X1=X,X2=X
94 . S:$D(DIKIL) (X2,X2(1),X2(2))=""
95 . D KDGPT9M^DGPTDDCR(.X,.DA,"M ICD3")
96CR4 S DIXR=465
97 K X
98 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
99 S X(1)=$P(DIKZ(0),U,10)
100 S X(2)=$P(DIKZ(0),U,8)
101 S X=$G(X(1))
102 I $G(X(1))]"",$G(X(2))]"" D
103 . K X1,X2 M X1=X,X2=X
104 . S:$D(DIKIL) (X2,X2(1),X2(2))=""
105 . D KDGPT9M^DGPTDDCR(.X,.DA,"M ICD4")
106CR5 S DIXR=466
107 K X
108 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
109 S X(1)=$P(DIKZ(0),U,10)
110 S X(2)=$P(DIKZ(0),U,9)
111 S X=$G(X(1))
112 I $G(X(1))]"",$G(X(2))]"" D
113 . K X1,X2 M X1=X,X2=X
114 . S:$D(DIKIL) (X2,X2(1),X2(2))=""
115 . D KDGPT9M^DGPTDDCR(.X,.DA,"M ICD5")
116CR6 S DIXR=467
117 K X
118 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
119 S X(1)=$P(DIKZ(0),U,10)
120 S X(2)=$P(DIKZ(0),U,11)
121 S X=$G(X(1))
122 I $G(X(1))]"",$G(X(2))]"" D
123 . K X1,X2 M X1=X,X2=X
124 . S:$D(DIKIL) (X2,X2(1),X2(2))=""
125 . D KDGPT9M^DGPTDDCR(.X,.DA,"M ICD6")
126CR7 S DIXR=468
127 K X
128 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
129 S X(1)=$P(DIKZ(0),U,10)
130 S X(2)=$P(DIKZ(0),U,12)
131 S X=$G(X(1))
132 I $G(X(1))]"",$G(X(2))]"" D
133 . K X1,X2 M X1=X,X2=X
134 . S:$D(DIKIL) (X2,X2(1),X2(2))=""
135 . D KDGPT9M^DGPTDDCR(.X,.DA,"M ICD7")
136CR8 S DIXR=469
137 K X
138 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
139 S X(1)=$P(DIKZ(0),U,10)
140 S X(2)=$P(DIKZ(0),U,13)
141 S X=$G(X(1))
142 I $G(X(1))]"",$G(X(2))]"" D
143 . K X1,X2 M X1=X,X2=X
144 . S:$D(DIKIL) (X2,X2(1),X2(2))=""
145 . D KDGPT9M^DGPTDDCR(.X,.DA,"M ICD8")
146CR9 S DIXR=470
147 K X
148 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
149 S X(1)=$P(DIKZ(0),U,10)
150 S X(2)=$P(DIKZ(0),U,14)
151 S X=$G(X(1))
152 I $G(X(1))]"",$G(X(2))]"" D
153 . K X1,X2 M X1=X,X2=X
154 . S:$D(DIKIL) (X2,X2(1),X2(2))=""
155 . D KDGPT9M^DGPTDDCR(.X,.DA,"M ICD9")
156CR10 S DIXR=471
157 K X
158 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
159 S X(1)=$P(DIKZ(0),U,10)
160 S X(2)=$P(DIKZ(0),U,15)
161 S X=$G(X(1))
162 I $G(X(1))]"",$G(X(2))]"" D
163 . K X1,X2 M X1=X,X2=X
164 . S:$D(DIKIL) (X2,X2(1),X2(2))=""
165 . D KDGPT9M^DGPTDDCR(.X,.DA,"M ICD10")
166CR11 K X
167 G:'$D(DIKLM) A Q:$D(DIKILL)
168END G ^DGPTXX5
Note: See TracBrowser for help on using the repository browser.