source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMREDF.m@ 1800

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

revised back to 6/30/08 version

File size: 9.0 KB
RevLine 
[623]1PXRMREDF ; SLC/PJH - Edit PXRM reminder findings. ;02/09/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ; Called by PXRMREDT which newes and initialized DEF, DEF1, DEF2.
5 ;
6SET S:'$D(^PXD(811.9,DA,20,0)) ^PXD(811.9,DA,20,0)="^811.902V" Q
7 ;Display ALL findings
8 ;
9 ;--------------------
10DSPALL(TYPE,NODE,DA,LIST) ;
11 N FIRST,SUB,SUB1,SUB2
12 S FIRST=1,SUB="",SUB1="",SUB2=""
13 F S SUB=$O(LIST(SUB)) Q:SUB="" D
14 .S SUB1=0
15 .F S SUB1=$O(LIST(SUB,SUB1)) Q:SUB1="" D
16 ..S SUB2=0 F S SUB2=$O(LIST(SUB,SUB1,SUB2)) Q:SUB2="" D
17 ...I FIRST S FIRST=0 W !!,"Choose from:",!
18 ...W SUB
19 ...W ?5,SUB1,?65,"Finding #: "_SUB2,!
20 I FIRST,TYPE="D" W !!,"Reminder has no findings",!
21 I FIRST,TYPE="T" W !!,"Reminder Term has no findings",!
22 ;Update
23 D LIST^PXRMREDT(NODE,DA,.LIST)
24 Q
25 ;
26 ;Edit individual FINDING entry
27 ;-----------------------------
28FEDIT(IEN) ;
29 N CFIEN,DA,DIC,DIE,DR,ETYPE,GLOB
30 N STATUS,TERMSTAT,TIEN,TERMTYPE,VF,WPIEN,Y
31 S DA(1)=IEN
32 S DIC="^PXD(811.9,"_IEN_",20,"
33 I $P(^PXD(811.9,IEN,100),U)="N",$G(PXRMINST)'=1 S DIC(0)="QEA"
34 E S DIC(0)="QEAL"
35 S DIC("A")="Select FINDING: "
36 S DIC("P")="811.902V"
37 D ^DIC I Y=-1 S DTOUT=1 Q
38 S DIE=DIC K DIC
39 S DA=+Y,GLOB=$P($P(Y,U,2),";",2) Q:GLOB=""
40 S TYPE=$G(DEF1(GLOB))
41 S SDA(2)=DA(1),SDA(1)=DA
42 ;Save term IEN
43 S STATUS=0
44 I TYPE="RT" S TIEN=$P($P(Y,U,2),";",1)
45 I TYPE="CF" S CFIEN=$P($P(Y,U,2),";",1) D
46 .I $D(^PXRMD(811.4,CFIEN,1))>0 D
47 ..W !!,"Computed Finding Description:" S WPIEN=0
48 ..F S WPIEN=$O(^PXRMD(811.4,CFIEN,1,WPIEN)) Q:+WPIEN'>0 D
49 ...W !,$G(^PXRMD(811.4,CFIEN,1,WPIEN,0))
50 .E W !!,"No description defined for this computed finding"
51 ;Finding record fields
52 W !!,"Editing Finding Number: "_$G(DA)
53 S DR=".01;3;I X=""0Y"" S Y=6;1;2;6;7;8;9;12;17"
54 ;Taxonomy - use inactive problems
55 I TYPE="TX" D
56 .S TERMSTAT=$$TAXNODE^PXRMSTA1($P($P(Y,U,2),";"),"H")
57 .I TERMSTAT="P" S DR=DR_";10" Q
58 .I TERMSTAT'=0 S DR=DR_";10",STATUS=1
59 I TYPE="RT" D
60 .S TERMTYPE=$$TERMTYPE(TIEN)
61 .I TERMTYPE["H" S DR=DR_";11"
62 ;Health Factor - within category rank
63 I TYPE="HF" S DR=DR_";11"
64 ;If V file INCLUDE VISIT DATA
65 S VF=$S(TYPE="ED":1,TYPE="EX":1,TYPE="HF":1,TYPE="IM":1,TYPE="ST":1,TYPE="TX":1,1:0)
66 I TYPE="RT",$P(TERMTYPE,U,2)="VF" S VF=1
67 I VF S DR=DR_";28"
68 ;
69 ;Mental Health - scale
70 I TYPE="MH" S DR=DR_";13"
71 ;Radiology procedure.
72 I TYPE="RP" S STATUS=1
73 ;Orderable Item
74 I TYPE="OI" S DR=DR_";27",STATUS=1
75 ;Rx Type
76 I (TYPE="DC")!(TYPE="DG")!(TYPE="DR") S DR=DR_";16;27",STATUS=1
77 ;Condition
78 S DR=DR_";14;15;18"
79 I TYPE="CF" S DR=DR_";26"
80 ;Found/not found text
81 S DR=DR_";4;5"
82 ;
83 I TYPE="RT" D
84 . I TERMTYPE["D" S DR=DR_";16;27",STATUS=1
85 . I TERMTYPE["O" S DR=DR_";27",STATUS=1
86 . I TERMTYPE["R" S STATUS=1
87 . I TERMTYPE["T" S STATUS=1
88 .I TERMTYPE[2 D
89 .. N MSG
90 .. S MSG(1)="Cannot set a status since the term contains multiple types of findings"
91 .. S MSG(2)="Edit the status field at the term level for each finding" H 2
92 .. D EN^DDIOL(.MSG)
93 ;Edit finding record
94 D ^DIE
95 S $P(^PXD(811.9,IEN,20,0),U,3)=0
96 I $D(Y) S DTOUT=1 Q
97 ;Check if deleted
98 I '$D(DA) Q
99 I STATUS=1 D STATUS^PXRMSTA1(.DA,"D")
100 ;
101 S ETYPE=$P(^PXD(811.9,IEN,20,SDA(1),0),U,1)
102 ;Option to edit term findings
103 I $P(ETYPE,";",2)="PXRMD(811.5," D
104 . S TIEN=$P(ETYPE,";",1)
105 . D TMAP(IEN,TIEN)
106 Q
107 ;
108 ;Edit individual function finding entry
109 ;-----------------------------
110FFEDIT(IEN) ;
111 N DA,DIC,DIE,DR,Y
112 S DA(1)=IEN
113 S DIC="^PXD(811.9,"_IEN_",25,"
114 S DIC(0)="QEAL"
115 S DIC("A")="Select FUNCTION FINDING: "
116 D ^DIC
117 I Y=-1 S DTOUT=1 Q
118 S DIE=DIC K DIC
119 S DA=+Y
120 ;Finding record fields
121 S DR=".01;3"
122 ;Edit finding record
123 D ^DIE
124 I $D(Y) S DTOUT=1 Q
125 I '$D(DA) Q
126 ;If the function string is null don't do the rest of the fields.
127 I $G(^PXD(811.9,IEN,25,DA,3))="" Q
128 S DR="1;2;11;12;15;I X=""0Y"" S Y=16;13;14;16"
129 D ^DIE
130 I $D(Y) S DTOUT=1 Q
131 I '$D(DA) Q
132 ;Check if deleted
133 Q
134 ;
135 ;Edit Reminder Function Findings
136 ;----------------------
137FFIND ;
138 N DTOUT,DUOUT
139 F D Q:$D(DUOUT)!$D(DTOUT)
140 .D FFEDIT(DA) I $D(DUOUT)!$D(DTOUT) Q
141 K DUOUT,DTOUT
142 Q
143 ;
144 ;Edit Reminder Findings
145 ;----------------------
146FIND(LIST) ;
147 N DTOUT,DUOUT,NODE,SDA
148 D SET ; Check if node defined
149 S NODE="^PXD(811.9)"
150 F D Q:$D(DUOUT)!$D(DTOUT)
151 .;Display list of existing reminder findings
152 .W !!,"Reminder Definition Findings"
153 .D DSPALL("D",NODE,DA,.LIST)
154 .;Edit findings
155 .D FEDIT(DA) I $D(DUOUT)!$D(DTOUT) D LIST^PXRMREDT(NODE,DA,.LIST) Q
156 .;Update list with finding changes
157 .D LIST^PXRMREDT(NODE,DA,.LIST)
158 Q
159 ;
160 ;General help text routine
161 ;-------------------------
162HELP(CALL) ;
163 N HTEXT
164 N DIWF,DIWL,DIWR,IC
165 S DIWF="C70",DIWL=0,DIWR=70
166 ;
167 I CALL=1 D
168 .S HTEXT(1)="Select the type of finding you wish to change or add."
169 .S HTEXT(2)="Type '?' for a list of the available finding types."
170 I CALL=2 D
171 .S HTEXT(1)="Select section of the reminder you wish to edit or 'All'"
172 .S HTEXT(2)="to step through all sections of the reminder definition."
173 I CALL=3 D
174 .S HTEXT(1)="Select 'Y' to edit the findings mapped to this term"
175 .S HTEXT(2)="or 'N' to return to select another reminder finding."
176 ;
177 K ^UTILITY($J,"W")
178 S IC=""
179 F S IC=$O(HTEXT(IC)) Q:IC="" D
180 . S X=HTEXT(IC)
181 . D ^DIWP
182 W !
183 S IC=0
184 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
185 . W !,^UTILITY($J,"W",0,IC,0)
186 K ^UTILITY($J,"W")
187 W !
188 Q
189 ;
190 ;Display TERM findings
191 ;--------------------
192TDSP(DA) ;
193 N FIRST,SUB,TLST S FIRST=1,SUB="",SUB1=""
194 ;Build list of term findings
195 D TLST(.TLST,DA)
196 ;Display list
197 F S SUB=$O(TLST(SUB)) Q:SUB="" D
198 .S SUB1=0
199 .F S SUB1=$O(TLST(SUB,SUB1)) Q:SUB1="" D
200 ..I FIRST S FIRST=0 W !!,"Reminder Term Findings:",!!
201 ..W SUB
202 ..W ?8,SUB1,!
203 I FIRST W !!,"Term has no mapped findings",!!
204 Q
205 ;
206 ;List Reminders using this term
207 ;------------------------------
208TERMS(TIEN,RIEN) ;
209 ;RIEN will be the reminder ien if called from reminder edit
210 ;or zero if called from term edit
211 N ARRAY,FIND,IEN,SUB,TCNT,RNAME
212 ;Scan all reminders in file #811.9
213 S IEN=0,FIND="PXRMD(811.5,",TCNT=0
214 F S IEN=$O(^PXD(811.9,IEN)) Q:'IEN D
215 .;Exclude current reminder called in reminder edit
216 .I RIEN,IEN=RIEN Q
217 .;Check the term findings
218 .I '$D(^PXD(811.9,IEN,20,"E",FIND,TIEN)) Q
219 .;Add to reminder array
220 .S RNAME=$P($G(^PXD(811.9,IEN,0)),U)
221 .I RNAME="" S RNAME=IEN
222 .I '$D(ARRAY(RNAME)) S TCNT=TCNT+1
223 .S ARRAY(RNAME)=""
224 ;
225 ;Display list of reminders using the term
226 I TCNT D
227 .N TXT
228 .S TXT="This Reminder Term is" S:RIEN TXT=TXT_" also"
229 .S TXT=TXT_" used by the following Reminder Definition"
230 .I TCNT>1 S TXT=TXT_"s"
231 .W !!,TXT_":"
232 .S RNAME="" F S RNAME=$O(ARRAY(RNAME)) Q:RNAME="" W !," ",RNAME
233 Q
234 ;
235 ;------------------------------
236 ;Check term for finding item to edit status item
237TERMTYPE(TIEN) ;
238 N DRUG,FOUND,HF,ORD,OTHER,RAD,RESULT,TAX,TYPE,VF
239 S (DRUG,FOUND,HF,ORD,OTHER,RAD,RESULT,TAX,VF)=0
240 S TYPE="" F S TYPE=$O(^PXRMD(811.5,TIEN,20,"B",TYPE)) Q:TYPE="" D
241 . I TYPE["AUTTEDT(" S (OTHER,VF)=1 Q
242 . I TYPE["AUTTHF(" S (HF,OTHER,VF)=1 Q
243 . I TYPE["AUTTIMM(" S (OTHER,VF)=1 Q
244 . I TYPE["AUTTSK(" S (OTHER,VF)=1 Q
245 . I TYPE["ORD" S (ORD,FOUND)=1 Q
246 . I TYPE["PS" S (DRUG,FOUND)=1 Q
247 . I TYPE["PXD(811.2" S (FOUND,TAX,VF)=1 Q
248 . I TYPE["RAMIS" S (FOUND,RAD)=1 Q
249 . S OTHER=1
250 I RAD=1,ORD=0,TAX=0,DRUG=0,OTHER=0 S RESULT="R"
251 I RAD=0,ORD=1,TAX=0,DRUG=0,OTHER=0 S RESULT="O"
252 I RAD=0,ORD=0,TAX=1,DRUG=0,OTHER=0 S RESULT="T"
253 I RAD=0,ORD=0,TAX=0,DRUG=1,OTHER=0 S RESULT="D"
254 I OTHER=1 S RESULT=1 I FOUND=1 S RESULT=2
255 I RESULT="T" S RESULT=$$TAXTYPE^PXRMSTA1(TIEN,"")
256 I HF=1 S RESULT="H"_RESULT
257 I VF=1 S RESULT=RESULT_U_"VF"
258 Q RESULT
259 ;
260 ;Build list of mapped findings for term
261 ;--------------------------------------
262TLST(ARRAY,DA) ;
263 N TYPE,DATA,GLOB,IEN,NAME,NODE,SUB
264 ;Clear passed arrays
265 K ARRAY
266 ;Build cross reference global to file number
267 ;Get each finding
268 S SUB=0 F S SUB=$O(^PXRMD(811.5,DA,20,SUB)) Q:'SUB D
269 .S DATA=$G(^PXRMD(811.5,DA,20,SUB,0)) I DATA="" Q
270 .;Determine global and global ien
271 .S NODE=$P(DATA,U),GLOB=$P(NODE,";",2),IEN=$P(NODE,";")
272 .;Ignore null entries
273 .I (GLOB="")!(IEN="") Q
274 .;Work out the file type
275 .S TYPE=$G(DEF1(GLOB)) Q:TYPE=""
276 .S NAME=$P($G(@(U_GLOB_IEN_",0)")),U)
277 .S ARRAY(TYPE,NAME)=""
278 Q
279 ;
280 ;Map Term findings
281 ;-----------------
282TMAP(RIEN,TIEN) ;
283 N TOPT,TNAM
284 ;Display any other reminders using this term
285 D TERMS(TIEN,RIEN)
286 ;Term name
287 S TNAM=$P($G(^PXRMD(811.5,TIEN,0)),U)
288 ;Give option to edit mapped findings (Y/N)
289 D TMASK(.TOPT,TNAM) Q:$D(DUOUT)!($D(DTOUT))
290 ;Edit term findings
291 I TOPT="Y" D TRMED(TIEN)
292 Q
293 ;
294 ;Option to edit term findings
295 ;----------------------------
296TMASK(YESNO,TNAM) ;
297 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
298 S DIR(0)="YA0"
299 S DIR("A")="Do you want to edit mapped findings for "_TNAM_": "
300 S (DIR("B"),YESNO)="N"
301 S DIR("?")="Enter Y or N. For detailed help type ??"
302 S DIR("??")=U_"D HELP^PXRMREDF(3)"
303 W !
304 D ^DIR K DIR
305 I $D(DIROUT)!$D(DIRUT) Q
306 I $D(DTOUT)!$D(DUOUT) Q
307 S YESNO=$E(Y(0))
308 Q
309 ;
310 ;Term edit
311 ;---------
312TRMED(DA) ;
313 N CS1,CS2,DIC,DLAYGO,DTOUT,DUOUT,Y
314 K DLAYGO,DTOUT,DUOUT,Y
315 ;Display term findings
316 D TDSP(DA)
317 ;Initialize change history
318 S CS1=$$FILE^PXRMEXCS(811.5,DA)
319 ;Edit term findings
320 S DIC="^PXRMD(811.5,"
321 D EDIT^PXRMTMED(DIC,DA)
322 ;Update change history
323 S CS2=$$FILE^PXRMEXCS(811.5,DA)
324 I CS2=0 Q
325 I CS2'=CS1 D SEHIST^PXRMUTIL(811.5,DIC,DA)
326 Q
327 ;
Note: See TracBrowser for help on using the repository browser.