source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMGECU.m@ 1766

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

initial load of WorldVistAEHR
File size: 9.4 KB
RevLine 
[613]1PXRMGECU ;SLC/AGP,JVS - CLINICAL REMINDERS ;7/14/05 10:45
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 Q
4FINISHED(DFN,ANS) ;Delete 801.5 entries if finished
5 ;ANS=Answer to YES/NO button should be 1 or will quit
6 Q:DFN=""
7 Q:ANS=0
8 S PATDA="" F S PATDA=$O(^PXRMD(801.5,"B",DFN,PATDA)) Q:PATDA="" D
9 .S DA=PATDA,DIK="^PXRMD(801.5," D ^DIK
10 K DA,DIK,PATDA
11 Q
12 ;
13CON(IEN,DFN) ;CHECK TO see if 2 DIA ARE DONE to display consult
14 N OK
15 ;
16 S OK=0
17 S GEC1DA=$O(^PXRMD(801.41,"AC","GEC1",0))
18 S GEC2DA=$O(^PXRMD(801.41,"AC","GEC2",0))
19 S GEC3DA=$O(^PXRMD(801.41,"AC","GEC3",0))
20 S GECFDA=$O(^PXRMD(801.41,"AC","GECF",0))
21 Q:IEN'=GEC1DA!(IEN'=GEC2DA)!(IEN'=GEC3DA) OK
22 ;
23 S CNT=0
24 I $D(^PXRMD(801.5,"AD",DFN,"GEC1")) S CNT=CNT+1
25 I $D(^PXRMD(801.5,"AD",DFN,"GEC2")) S CNT=CNT+1
26 I $D(^PXRMD(801.5,"AD",DFN,"GEC3")) S CNT=CNT+1
27 ;
28 I CNT>1 S OK=1
29 Q OK
30 ;
31DEL(NOTEIEN) ;Delete HF and 801.5 Called from DELETE^TIUEDI1
32 N DFN,TIUNODE,FILEIEN,GEC,ENCDT,GECNODE,GECT,GECDA,HFDA
33 N HFARY
34 Q:'$D(^PXRMD(801.5,"ACOPY",NOTEIEN))
35 S DFN=$O(^PXRMD(801.5,"ACOPY",NOTEIEN,0))
36 S ENCDT=$O(^PXRMD(801.5,"ACOPY",NOTEIEN,DFN,0))
37 I $D(^PXRMD(801.5,"ANOTE",NOTEIEN)) D
38 .S GEC="" F S GEC=$O(^PXRMD(801.5,"ANOTE",NOTEIEN,GEC)) Q:GEC="" D
39 ..S FILEIEN=0 F S FILEIEN=$O(^PXRMD(801.5,"ANOTE",NOTEIEN,GEC,FILEIEN)) Q:FILEIEN="" D
40 ...S GECNODE=$G(^PXRMD(801.5,FILEIEN,0))
41 ...S GECT=$P(GECNODE,"^",3),GECDA=$O(^PX(839.7,"B",GECT,0))
42 ...S HFDA=0 F S HFDA=$O(^AUPNVHF("AED",ENCDT,DFN,GECDA,HFDA)) Q:HFDA="" D
43 ....S HFARY(HFDA)=""
44 ...S DA=FILEIEN S DIK="^PXRMD(801.5," D ^DIK
45 E I $D(^PXRMD(801.5,"ACOPY",NOTEIEN)) D
46 .S GECT="" F S GECT=$O(^PXRMD(801.5,"ACOPY",NOTEIEN,DFN,ENCDT,GECT)) Q:GECT="" D
47 ..S GECDA=$O(^PX(839.7,"B",GECT,0))
48 ..S HFDA=0 F S HFDA=$O(^AUPNVHF("AED",ENCDT,DFN,GECDA,HFDA)) Q:HFDA="" D
49 ...S HFARY(HFDA)=""
50 I $D(HFARY) D
51 .;
52 .N ZTIO,ZTRTN,ZTDTH,ZTSAVE,ZTDESC,ZTSK,GECIEN,GET
53 .;
54 .S ZTIO="ORW/PXAPI RESOURCE"
55 .S ZTRTN="REMOVE^PXRMGECK"
56 .S ZTDTH=$H
57 .S ZTSAVE("GECT")=""
58 .S ZTSAVE("HFARY(")=""
59 .S ZTDESC="PXRM remove Health Factors for GEC"
60 .D ^%ZTLOAD
61 ;Clean up ACOPY nodes
62 D ACOPYDEL^PXRMGECK
63 Q
64 ;
65API(RESULT,IEN,DFN,VISIT,WHERE,NOTEIEN) ;
66 I '$D(NOTEIEN) S NOTEIEN=1
67 N GEC,DFNDT
68 S GEC=$$CHECKGEC(IEN)
69 I $G(GEC)="" S RESULT=0_U_"" Q
70 S RESULT=1_U_$$GECDT(DFN,GEC,VISIT,NOTEIEN)_";"_GEC_U_$$EVAL(DFN,GEC,WHERE)
71 ;
72 Q
73 ;
74CHECKGEC(IEN) ;
75 N RIEN,DIEN
76 I IEN["R" D
77 . S RIEN=$E(IEN,2,$L(IEN)) S DIEN=$G(^PXD(811.9,RIEN,51))
78 . I $G(DIEN)'="" S GEC=$P($G(^PXRMD(801.41,DIEN,0)),U,16)
79 E S GEC=$P($G(^PXRMD(801.41,IEN,0)),U,16)
80 Q $G(GEC)
81 ;
82GECDT(DFN,GEC,VISIT,NOTEIEN) ;Get Date/Time from file
83 N STOP
84 S STOP=0
85 I $D(^PXRMD(801.5,"B",DFN)) D CURADD
86 I '$D(^PXRMD(801.5,"B",DFN)) D NEWADD
87 S DFNDT=$O(^PXRMD(801.5,"AC",DFN,0))
88 Q DFNDT
89 ;
90NEWADD ;-Set Data into File 801.5 and 801.55 (history)
91 Q:STOP=1
92 D
93 .Q:$D(^PXRMD(801.5,"AD",DFN,GEC))
94 .S GEX(1,801.5,"+1,",.01)=DFN
95 .S GEX(1,801.5,"+1,",.02)=$$NOW^XLFDT
96 .S GEX(1,801.5,"+1,",.03)=GEC
97 .S GEX(1,801.5,"+1,",.04)=+$G(NOTEIEN)
98 .S GEX(1,801.5,"+1,",.05)=DUZ
99 .S GEX(1,801.5,"+1,",.06)=DT
100 .S ^PXRMD(801.5,"ACOPY",+$G(NOTEIEN),DFN,$G(GEX(1,801.5,"+1,",.02)),GEC,DT)=""
101 .D UPDATE^DIE("","GEX(1)")
102 ;--HISTORY FILE
103 S GEX(2,801.55,"+1,",.01)=DFN
104 S GEX(2,801.55,"+1,",.02)=$$NOW^XLFDT
105 S GEX(2,801.55,"+1,",.03)=GEC
106 S GEX(2,801.55,"+1,",.04)=+$G(NOTEIEN)
107 S GEX(2,801.55,"+1,",.05)=DUZ
108 S GEX(2,801.55,"+1,",.06)=DT
109 D UPDATE^DIE("","GEX(2)")
110 K GEX
111 S STOP=1
112 Q
113CURADD ;-Set Data into File 801.5 and 801.55 (history)
114 Q:STOP=1
115 D
116 .Q:$D(^PXRMD(801.5,"AD",DFN,GEC))
117 .S GEX(1,801.5,"+1,",.01)=DFN
118 .S GEX(1,801.5,"+1,",.02)=$O(^PXRMD(801.5,"AC",DFN,0))
119 .S GEX(1,801.5,"+1,",.03)=GEC
120 .S GEX(1,801.5,"+1,",.04)=+$G(NOTEIEN)
121 .S GEX(1,801.5,"+1,",.05)=DUZ
122 .S GEX(1,801.5,"+1,",.06)=DT
123 .S ^PXRMD(801.5,"ACOPY",+$G(NOTEIEN),DFN,$G(GEX(1,801.5,"+1,",.02)),GEC,DT)=""
124 .D UPDATE^DIE("","GEX(1)")
125 ;--HISTORY FILE
126 S GEX(2,801.55,"+1,",.01)=DFN
127 S GEX(2,801.55,"+1,",.02)=$O(^PXRMD(801.5,"AC",DFN,0))
128 S GEX(2,801.55,"+1,",.03)=GEC
129 S GEX(2,801.55,"+1,",.04)=+$G(NOTEIEN)
130 S GEX(2,801.55,"+1,",.05)=DUZ
131 S GEX(2,801.55,"+1,",.06)=DT
132 D UPDATE^DIE("","GEX(2)")
133 K GEX
134 S STOP=1
135 Q
136 ;
137STATUS(DFN) ;Evaluate The status of the Referral
138 ;
139 N STOP,ZTSK
140 S STOP=0
141 I $D(^PXRMD(801.5,"ATASK",DFN)) S ZTSK=$O(^PXRMD(801.5,"ATASK",DFN,0)) D
142 .D STAT^%ZTLOAD
143 .I ZTSK(0)=1 D
144 ..I 12[ZTSK(1) D
145 ...S MESSAGE="Data is Changing!! Please Check Status Again^GEC Referral NO Status Available^0"
146 ...S STOP=1
147 Q:STOP=1 MESSAGE
148 ;
149 ;Returned
150 ;sentence ~ sentence ~ sentence ^ OK or YES/NO BOX
151 ;
152 N MISSING,MESSAGE,HFDA,STOP,BOX
153 S BOX=1
154 D ACOPYDEL^PXRMGECK
155 ;
156 ;GET IEN FOR DATA SOURCES FOR GEC
157 I $D(^PX(839.7,"B","GEC1")) S GEC1=$O(^PX(839.7,"B","GEC1",""))
158 I $D(^PX(839.7,"B","GEC2")) S GEC2=$O(^PX(839.7,"B","GEC2",""))
159 I $D(^PX(839.7,"B","GEC3")) S GEC3=$O(^PX(839.7,"B","GEC3",""))
160 I $D(^PX(839.7,"B","GECF")) S GECF=$O(^PX(839.7,"B","GECF",""))
161 ;
162 S STOP=0
163 S MESSAGE=" No GEC Referral in progress.^GEC Referral Status"
164 S HFDA="" F S HFDA=$O(^AUPNVHF("C",DFN,HFDA)) Q:HFDA="" Q:STOP=1 D
165 .I $D(^AUPNVHF(HFDA,12)) D
166 ..I $P($G(^AUPNVHF(HFDA,12)),"^",1)>0 D
167 ...S SOURCE=$P($G(^AUPNVHF(HFDA,812)),"^",3)
168 ...Q:SOURCE=""
169 ...I (SOURCE=$G(GEC1))!(SOURCE=$G(GEC2))!(SOURCE=$G(GEC3))!(SOURCE=$G(GECF)) D
170 ....S STOP=1
171 ;
172 S (MISSING)=""
173 I '$D(^PXRMD(801.5,"B",DFN))&(STOP=0) D
174 .S MESSAGE=" No GEC Referral on record.^Current GEC Referral Status"
175 Q:'$D(^PXRMD(801.5,"B",DFN)) MESSAGE
176 S MESSAGE=""
177 ;
178 ;
179 ; A. look for missing dialog
180 S:'$D(^PXRMD(801.5,"AD",DFN,"GEC1")) MISSING=MISSING_1_"^"
181 S:'$D(^PXRMD(801.5,"AD",DFN,"GEC2")) MISSING=MISSING_2_"^"
182 S:'$D(^PXRMD(801.5,"AD",DFN,"GEC3")) MISSING=MISSING_3_"^"
183 S:'$D(^PXRMD(801.5,"AD",DFN,"GECF")) MISSING=MISSING_4
184 ; a. if none missing then set message
185 ;I MISSING="" D
186 ; b. if missing then create message
187 I MISSING'=""!(MISSING="") D
188 .S MESSAGE="The following Dialogs are Complete:~"
189 .S:MISSING'[1 MESSAGE=MESSAGE_$P($T(T+7),";",3) D
190 ..I +$$TIUSTAT^PXRMGECK(DFN,"GEC1") D
191 ...S MESSAGE=MESSAGE_"~"_" Note is "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC1"),":",2)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC1"),":",4)_"~"
192 .S:MISSING'[2 MESSAGE=MESSAGE_$P($T(T+8),";",3) D
193 ..I +$$TIUSTAT^PXRMGECK(DFN,"GEC2") D
194 ...S MESSAGE=MESSAGE_"~"_" Note is "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC2"),":",2)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC2"),":",4)_"~"
195 .S:MISSING'[3 MESSAGE=MESSAGE_$P($T(T+9),";",3) D
196 ..I +$$TIUSTAT^PXRMGECK(DFN,"GEC3") D
197 ...S MESSAGE=MESSAGE_"~"_" Note is "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC3"),":",2)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC3"),":",4)_"~"
198 .S:MISSING'[4 MESSAGE=MESSAGE_$P($T(T+10),";",3) D
199 ..I +$$TIUSTAT^PXRMGECK(DFN,"GECF") D
200 ...S MESSAGE=MESSAGE_"~"_" Note is "_$P($$TIUSTAT^PXRMGECK(DFN,"GECF"),":",2)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GECF"),":",4)_"~"
201 .I $E(MESSAGE,$L(MESSAGE))'="~" S MESSAGE=MESSAGE_"~"
202 .I MISSING'="" S MESSAGE=MESSAGE_$P($T(T+11),";",3)
203 .S:MISSING[1 MESSAGE=MESSAGE_$P($T(T+7),";",3)
204 .S:MISSING[2 MESSAGE=MESSAGE_$P($T(T+8),";",3)
205 .S:MISSING[3 MESSAGE=MESSAGE_$P($T(T+9),";",3)
206 .S:MISSING[4 MESSAGE=MESSAGE_$P($T(T+10),";",3)
207 ;
208 I MISSING="" S MESSAGE=MESSAGE_"~"_$P($T(T+5),";",3)
209 S MESSAGE=MESSAGE_$P($T(T+6),";",3)
210 S MESSAGE=MESSAGE_"^Current GEC Referral Status"_"^"_BOX
211 ;
212 Q MESSAGE
213 ;
214EVAL(DFN,GEC,WHERE) ;Evaluate for missing dialogs
215 ;DFN=PATIENT DFN
216 ;GEC=Identify for Dialog
217 ;WHERE=What part of the dialog this call is comming from
218 ; 0=Object at the start
219 ; 1=Finished button
220 ;
221 ;Returned
222 ;Box Header ^ Message ^ Box display Flag
223 ;
224 ;Clean up ACOPY node
225 D ACOPYDEL^PXRMGECK
226 ;
227 N MISSING,MESSAGE,DIANAME,FORTH,BOX
228 ;
229 ;Getting the Names fo the dialogs
230 I GEC="GEC1" S DIANAME=$P($T(T+1),";",3)
231 I GEC="GEC2" S DIANAME=$P($T(T+2),";",3)
232 I GEC="GEC3" S DIANAME=$P($T(T+3),";",3)
233 I GEC="GECF" S DIANAME=$P($T(T+4),";",3)
234 ;
235 ;Check to see if 4th is done;add 1 or 0 to end of message
236 ;if 1 the GUI should bring up a modal box asking if finished
237 S FORTH=0
238 S:$D(^PXRMD(801.5,"AD",DFN,"GECF"))!(GEC["GECF") FORTH=1
239 I 'WHERE S FORTH=0
240 ;
241 ;
242 S (MISSING,MESSAGE)=""
243 Q:'$D(^PXRMD(801.5,"B",DFN)) MESSAGE
244 I WHERE Q:FORTH=0 MESSAGE
245 ;
246 ;
247 ; A. look for missing dialog
248 S:'$D(^PXRMD(801.5,"AD",DFN,"GEC1"))&(GEC'["GEC1") MISSING=MISSING_1_"^"
249 S:'$D(^PXRMD(801.5,"AD",DFN,"GEC2"))&(GEC'["GEC2") MISSING=MISSING_2_"^"
250 S:'$D(^PXRMD(801.5,"AD",DFN,"GEC3"))&(GEC'["GEC3") MISSING=MISSING_3_"^"
251 S:'$D(^PXRMD(801.5,"AD",DFN,"GECF"))&(GEC'["GECF") MISSING=MISSING_4
252 ; a. if none missing then set message
253 I MISSING="" D
254 .I WHERE S MESSAGE=$P($T(T+5),";",3)_$P($T(T+6),";",3)
255 .I 'WHERE S MESSAGE=$P($T(T+5),";",3)
256 ; b. if missing then create message
257 I MISSING'="" D
258 .S MESSAGE="The Following Dialogs are Missing:~"
259 .S:MISSING[1 MESSAGE=MESSAGE_$P($T(T+7),";",3)
260 .S:MISSING[2 MESSAGE=MESSAGE_$P($T(T+8),";",3)
261 .S:MISSING[3 MESSAGE=MESSAGE_$P($T(T+9),";",3)
262 .S:MISSING[4 MESSAGE=MESSAGE_$P($T(T+10),";",3)
263 .Q:'WHERE
264 .S MESSAGE=MESSAGE_$P($T(T+6),";",3)_$P($T(T+12),";",3)_$P($T(T+13),";",3)
265 ;
266 S BOX="GEC Referral Completion Status"
267 S MESSAGE=BOX_"^"_MESSAGE_"^"_FORTH
268 Q MESSAGE
269 ;
270T ;TEXT
271 ;; Social Services,
272 ;; Nursing Assessment,
273 ;; Care Recommendations,
274 ;; Care Coordination
275 ;; All Dialogs are Finished.
276 ;; ~~Is this Referral Complete?
277 ;; ~ Social Services
278 ;; ~ Nursing Assessment
279 ;; ~ Care Recommendations
280 ;; ~ Care Coordination
281 ;; ~The Following Dialogs are Missing:~
282 ;; ~~(If you select Yes, the current REFERRAL ~will be completed and the information ~from the missing dialogs cannot be added.
283 ;; ~~If you select No, the current REFERRAL ~remains open.)
284 Q
Note: See TracBrowser for help on using the repository browser.