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

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

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1DGPTXX11 ; COMPILED XREF FOR FILE #45.02 ; 12/12/07
2 ;
3 S DA=0
4A1 ;
5 I $D(DISET) 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 X ^DD(45.02,2,1,1,1.1) X ^DD(45.02,2,1,1,1.4)
14 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
15 S X=$P(DIKZ(0),U,5)
16 I X'="" S ^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,1)
19 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
20 S X=$P(DIKZ(0),U,6)
21 I X'="" S ^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,1)
24 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
25 S X=$P(DIKZ(0),U,7)
26 I X'="" S ^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,1)
29 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
30 S X=$P(DIKZ(0),U,8)
31 I X'="" S ^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,1)
34 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
35 S X=$P(DIKZ(0),U,9)
36 I X'="" S ^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,1)
39 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
40 S X=$P(DIKZ(0),U,10)
41 I X'="" S ^DGPT(DA(1),"M","AM",$E(X,1,30),DA)=""
42 S X=$P(DIKZ(0),U,11)
43 I X'="" S ^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,1)
46 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
47 S X=$P(DIKZ(0),U,12)
48 I X'="" S ^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,1)
51 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
52 S X=$P(DIKZ(0),U,13)
53 I X'="" S ^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,1)
56 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
57 S X=$P(DIKZ(0),U,14)
58 I X'="" S ^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,1)
61 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
62 S X=$P(DIKZ(0),U,15)
63 I X'="" S ^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,1)
66CR1 S DIXR=447
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 . D SDGPT9M^DGPTDDCR(.X,.DA,"M ICD1")
75CR2 S DIXR=448
76 K X
77 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
78 S X(1)=$P(DIKZ(0),U,10)
79 S X(2)=$P(DIKZ(0),U,6)
80 S X=$G(X(1))
81 I $G(X(1))]"",$G(X(2))]"" D
82 . K X1,X2 M X1=X,X2=X
83 . D SDGPT9M^DGPTDDCR(.X,.DA,"M ICD2")
84CR3 S DIXR=449
85 K X
86 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
87 S X(1)=$P(DIKZ(0),U,10)
88 S X(2)=$P(DIKZ(0),U,7)
89 S X=$G(X(1))
90 I $G(X(1))]"",$G(X(2))]"" D
91 . K X1,X2 M X1=X,X2=X
92 . D SDGPT9M^DGPTDDCR(.X,.DA,"M ICD3")
93CR4 S DIXR=450
94 K X
95 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
96 S X(1)=$P(DIKZ(0),U,10)
97 S X(2)=$P(DIKZ(0),U,8)
98 S X=$G(X(1))
99 I $G(X(1))]"",$G(X(2))]"" D
100 . K X1,X2 M X1=X,X2=X
101 . D SDGPT9M^DGPTDDCR(.X,.DA,"M ICD4")
102CR5 S DIXR=451
103 K X
104 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
105 S X(1)=$P(DIKZ(0),U,10)
106 S X(2)=$P(DIKZ(0),U,9)
107 S X=$G(X(1))
108 I $G(X(1))]"",$G(X(2))]"" D
109 . K X1,X2 M X1=X,X2=X
110 . D SDGPT9M^DGPTDDCR(.X,.DA,"M ICD5")
111CR6 S DIXR=452
112 K X
113 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
114 S X(1)=$P(DIKZ(0),U,10)
115 S X(2)=$P(DIKZ(0),U,11)
116 S X=$G(X(1))
117 I $G(X(1))]"",$G(X(2))]"" D
118 . K X1,X2 M X1=X,X2=X
119 . D SDGPT9M^DGPTDDCR(.X,.DA,"M ICD6")
120CR7 S DIXR=453
121 K X
122 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
123 S X(1)=$P(DIKZ(0),U,10)
124 S X(2)=$P(DIKZ(0),U,12)
125 S X=$G(X(1))
126 I $G(X(1))]"",$G(X(2))]"" D
127 . K X1,X2 M X1=X,X2=X
128 . D SDGPT9M^DGPTDDCR(.X,.DA,"M ICD7")
129CR8 S DIXR=454
130 K X
131 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
132 S X(1)=$P(DIKZ(0),U,10)
133 S X(2)=$P(DIKZ(0),U,13)
134 S X=$G(X(1))
135 I $G(X(1))]"",$G(X(2))]"" D
136 . K X1,X2 M X1=X,X2=X
137 . D SDGPT9M^DGPTDDCR(.X,.DA,"M ICD8")
138CR9 S DIXR=455
139 K X
140 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
141 S X(1)=$P(DIKZ(0),U,10)
142 S X(2)=$P(DIKZ(0),U,14)
143 S X=$G(X(1))
144 I $G(X(1))]"",$G(X(2))]"" D
145 . K X1,X2 M X1=X,X2=X
146 . D SDGPT9M^DGPTDDCR(.X,.DA,"M ICD9")
147CR10 S DIXR=456
148 K X
149 S DIKZ(0)=$G(^DGPT(DA(1),"M",DA,0))
150 S X(1)=$P(DIKZ(0),U,10)
151 S X(2)=$P(DIKZ(0),U,15)
152 S X=$G(X(1))
153 I $G(X(1))]"",$G(X(2))]"" D
154 . K X1,X2 M X1=X,X2=X
155 . D SDGPT9M^DGPTDDCR(.X,.DA,"M ICD10")
156CR11 K X
157 G:'$D(DIKLM) A Q:$D(DISET)
158END G ^DGPTXX12
Note: See TracBrowser for help on using the repository browser.