source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPREO23.m@ 1150

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

initial load of WorldVistAEHR
File size: 5.7 KB
Line 
1RMPREO23 ;HINES/HNC ;suspense processing display protocols ;10/9/2003
2 ;;3.0;PROSTHETICS;**45,55,62,77,80**;Feb 09, 1996
3 ; RVD 1/16/01 #62 -added a selected range for linked suspense
4 ; for initial, post other and complete action only.
5 ;RVD patch #77 - check for ^tmp global and XRMPRDFN variable
6 Q
7DIS ;display 2319 action
8 S RMPRBAC1=1
9 D FULL^VALM1
10 S XRMPRDFN=RMPRDFN
11 D ^RMPRPAT
12 K RMPRBAC1,RMPRBACK
13 S VALMBCK="R"
14 Q:'$D(XRMPRDFN)
15 S (RMPRDFN,DFN)=XRMPRDFN D DEM^VADPT
16 S RMPRNAM=$P(VADM(1),U,1)
17 S RMPRDOB=$P(VADM(3),U,1)
18 S RMPRSSN=$P(VADM(2),U,1)
19 K VADM,XRMPRDFN
20 Q
21 ;
22CHG ;change patient
23 D FULL^VALM1
24 S XRMPRDFN=RMPRDFN
25 D GETPAT^RMPRUTIL
26 I '$D(RMPRDFN) S RMPRDFN=XRMPRDFN
27 D INIT^RMPREO
28 S VALMBCK="R"
29 Q
30CANCEL ;cancel suspense
31 D FULL^VALM1
32 D NUM^RMPREOU
33 S RMPREOY=Y
34 F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D CANCEL^RMPREOS
35 K RMPREOY,XDA,DA,DUOUT
36 D INIT^RMPREO
37 S VALMBCK="R"
38 Q
39VIEW ;view consult request
40 N YY,DA,FLDS,DIC
41 D FULL^VALM1
42 D NUM^RMPREOU
43 I Y="" S VALMBCK="R"
44 ;
45 S RN=1,XDA=""
46 S RMPREOY=Y
47 F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 D VIEWP
48 K RMPREOY,DUOUT
49 S VALMBCK="R"
50 Q
51VIEWP ;
52 ;
53 Q:'$D(^TMP($J,"RMPREOEE",XDA,0))
54 S DA=^TMP($J,"RMPREOEE",XDA,0)
55 S L=0
56 S DIC="^RMPR(668,",FLDS="[RMPR VIEW REQUEST]"
57 S BY="@NUMBER",(FR,TO)=DA
58 ;prompt for device
59 ;S IOP="HOME"
60 D EN1^DIP
61 N DIR S DIR(0)="E" D ^DIR
62 W @IOF
63 S DA=^TMP($J,"RMPREOEE",XDA,0)
64 D VALL^RMPREO24(DA,.L) Q:L="^"
65 Q
66 ;
67PDISP ;print consultaton sheet
68 D NUM^RMPREOU
69 D FULL^VALM1
70 S RMPREOY=Y
71 F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D PDISPA
72 K RMPREOY,XDA,DA,DUOUT
73 D INIT^RMPREO
74 S VALMBCK="R"
75 Q
76PDISPA ;call consult api
77 ;pass DA ien to 668
78 D ENP^RMPREPDT
79 Q
80DDISP ;detail display
81 D NUM^RMPREOU
82 D FULL^VALM1
83 S RMPREOY=Y
84 F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D DDISPA
85 K RMPREOY,XDA,DA,DUOUT
86 D INIT^RMPREO
87 S VALMBCK="R"
88 Q
89DDISPA ;call list template from listmanager
90 ;pass DA ien to file 668
91 D EN^RMPREPDT
92 Q
93VIEWIA ;view initial action note
94 N YY,DIC,BY,FLDS,FR,TO,DA
95 D NUM^RMPREOU
96 D FULL^VALM1
97 ;
98 S RMPREOY=Y
99 F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D VIEWIAP
100 K RMPREOY,XDA,DA,DUOUT
101 S VALMBCK="R"
102 Q
103VIEWIAP ;loop
104 S L=0
105 S DIC="^RMPR(668,",FLDS="[RMPR VIEW INITIAL ACTION]"
106 S BY="@NUMBER",(FR,TO)=DA
107 S IOP="HOME"
108 W @IOF
109 D EN1^DIP
110 N DIR S DIR(0)="E" D ^DIR
111 Q
112 ;
113VIEWC ;view complete note
114 ;
115 N YY,DIC,BY,FLDS,FR,TO,DA
116 D NUM^RMPREOU
117 D FULL^VALM1
118 ;
119 S RMPREOY=Y
120 F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D VIEWCP
121 K RMPREOY,XDA,DA,DUOUT
122 S VALMBCK="R"
123 Q
124VIEWCP ;loop
125 S L=0
126 S DIC="^RMPR(668,",FLDS="[RMPR VIEW COMP NOTE]"
127 S BY="@NUMBER",(FR,TO)=DA
128 ;should we ask device?
129 ;S IOP="HOME"
130 W @IOF
131 D EN1^DIP
132 N DIR S DIR(0)="E" D ^DIR
133 Q
134 ;
135 ;
136VIEWO ;view other action notes
137 N YY,DIC,BY,FLDS,FR,TO,DA
138 D NUM^RMPREOU
139 D FULL^VALM1
140 S RMPREOY=Y
141 F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D VIEWOP
142 K RMPREOY,XDA,DA,DUOUT
143 S VALMBCK="R"
144 Q
145VIEWOP ;loop
146 S L=0
147 S DIC="^RMPR(668,",FLDS="[RMPR OACT NOTE]"
148 S BY="@NUMBER",(FR,TO)=DA
149 S IOP="HOME"
150 W @IOF
151 D EN1^DIP
152 N DIR S DIR(0)="E" D ^DIR
153 S VALMBCK="R"
154 Q
155 ;
156IACT ;take initial action
157 ;
158 N YY,DIC,BY,FLDS,FR,TO,DA
159 D NUM^RMPREOU
160 D FULL^VALM1
161 S RMPREOY=Y
162 F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D ENIA^RMPREOS
163 K RMPREOY,XDA,DA,DUOUT
164 I $G(RMSUCLFG) D INIT^RMPREOL
165 I '$G(RMSUCLFG) D INIT^RMPREO
166 S VALMBCK="R"
167 Q
168 ;
169OACT ;other notes
170 N YY,DIC,BY,FLDS,FR,TO,DA
171 D NUM^RMPREOU
172 D FULL^VALM1
173 S RMPREOY=Y
174 F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D OACT^RMPREOS
175 K RMPREOY,XDA,DA,DUOUT
176 I $G(RMSUCLFG) D INIT^RMPREOL
177 I '$G(RMSUCLFG) D INIT^RMPREO
178 S VALMBCK="R"
179 Q
180 ;
181CACT ;complete note
182 N YY,DIC,BY,FLDS,FR,TO,DA
183 D NUM^RMPREOU
184 D FULL^VALM1
185 S RMPREOY=Y
186 F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D CLNT^RMPREOS
187 K RMPREOY,XDA,DA,DUOUT
188 I $G(RMSUCLFG) D INIT^RMPREOL
189 I '$G(RMSUCLFG) D INIT^RMPREO
190 S VALMBCK="R"
191 Q
192 ;
193FORW ;forward consult
194 N YY,DIC,BY,FLDS,FR,TO,DA
195 D NUM^RMPREOU
196 D FULL^VALM1
197 S RMPREOY=Y
198 F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D FORW^RMPREOS
199 K RMPREOY,XDA,DA,DUOUT
200 D INIT^RMPREO
201 S VALMBCK="R"
202 Q
203AMAN ;add manual suspense
204 D FULL^VALM1
205 D EN^RMPREOS
206 D INIT^RMPREO
207 S VALMBCK="R"
208 Q
209 ;
210AAUTO ;add AUTO ADAPTIVE suspense
211 D FULL^VALM1
212 D EN^RMPREOSA
213 D INIT^RMPREO
214 S VALMBCK="R"
215 Q
216 ;
217ACLO ;add CLOTHING ALLOWANCE suspense
218 D FULL^VALM1
219 D EN1^RMPREOSA
220 D INIT^RMPREO
221 S VALMBCK="R"
222 Q
223 ;
224CLONE ;Create Clone CPRS Suspense
225 ;new vars here
226 D NUM^RMPREOU
227 D FULL^VALM1
228 S RMPREOY=Y
229 F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D CLONEP
230 K RMPREOY,XDA,DA,DUOUT
231 D INIT^RMPREO
232 S VALMBCK="R"
233 Q
234 ;
235CLONEP ;Create Clone CPRS from loop
236 D EN2^RMPREOSA
237 Q
238 ;
239EMAN ;edit manual suspense
240 D FULL^VALM1
241 D NUM^RMPREOU
242 S RMPREOY=Y
243 S RN=""
244 F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D EMANP
245 K RMPREOY,XDA,DA,DUOUT,RN
246 Q
247EMANP ;edit manual supsense loop
248 D EN2^RMPREOS
249 D INIT^RMPREO
250 S VALMBCK="R"
251 Q
252 ;
253 ;END
Note: See TracBrowser for help on using the repository browser.