source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMREDT.m@ 1553

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

initial load of FOIAVistA 6/30/08 version

File size: 7.0 KB
Line 
1PXRMREDT ; SLC/PKR,PJH - Edit PXRM reminder definition. ;10/04/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;
4 ;=======================================================
5EEDIT ;Entry point for PXRM DEFINITION EDIT option.
6 ;Build list of finding file definitions.
7 N DEF,DEF1,DEF2
8 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
9 ;
10 N DA,DIC,DLAYGO,DTOUT,DUOUT,Y
11 S DIC="^PXD(811.9,"
12 S DIC(0)="AEMQL"
13 S DIC("A")="Select Reminder Definition: "
14 S DLAYGO=811.9
15GETNAME ;Get the name of the reminder definition to edit.
16 ;Set the starting place for additions.
17 D SETSTART^PXRMCOPY(DIC)
18 W !
19 S DIC("W")="W $$LUDISP^PXRMREDT(Y)"
20 D ^DIC
21 I ($D(DTOUT))!($D(DUOUT)) Q
22 I Y=-1 G END
23 S DA=$P(Y,U,1)
24 D ALL(DIC,DA)
25 G GETNAME
26END ;
27 Q
28 ;
29 ;=======================================================
30 ;Select section of reminder to edit, also called at ALL by PXRMEDIT.
31 ;----------------------------------
32ALL(DIC,DA) ;
33 ;Get list of findings/terms for reminder
34 N BLDLOGIC,CS1,CS2,LIST,NODE,OPTION,TYPE
35 S BLDLOGIC=0
36 ;Save the original checksum.
37 S CS1=$$FILE^PXRMEXCS(811.9,DA)
38 ;Build finding list
39 S NODE="^PXD(811.9)"
40 D LIST(NODE,DA,.LIST)
41 ;If this is a new reminder enter all fields
42 I $P(Y,U,3)=1 D EDIT(DIC,DA) Q
43 ;National reminder allows editing of term findings only
44 I '$$VEDIT^PXRMUTIL(DIC,DA) D Q:$D(DUOUT)!$D(DTOUT)
45 .S TYPE=""
46 .F S TYPE=$O(LIST(TYPE)) Q:TYPE="" D
47 .. I TYPE="RT" Q
48 .. K LIST(TYPE)
49 .I '$D(LIST) S DUOUT=1 Q
50 .S BLDLOGIC=1
51 .D TFIND(DA,.LIST)
52 .I $D(Y) S DUOUT=1
53 ;Otherwise choose fields to edit
54 I $$VEDIT^PXRMUTIL(DIC,DA) F D Q:$D(DUOUT)!$D(DTOUT)
55 .D OPTION Q:$D(DUOUT)!$D(DTOUT)
56 .;All details
57 .I OPTION="A" D
58 .. S BLDLOGIC=1
59 .. D EDIT(DIC,DA)
60 .;Set up local variables
61 .N DIE,DR S DIE=DIC N DIC
62 .;Descriptions
63 .I OPTION="G" D
64 ..D GEN
65 .;Baseline Frequency
66 .I OPTION="B" D
67 ..S BLDLOGIC=1
68 ..D BASE
69 .;Findings
70 .I OPTION="F" D
71 ..S BLDLOGIC=1
72 ..D FIND(.LIST)
73 .;Function findings
74 .I OPTION="FF" D
75 ..S BLDLOGIC=1
76 ..D FFIND
77 .;Logic
78 .I OPTION="L" D
79 ..S BLDLOGIC=1
80 ..D LOGIC
81 .;Custom date due
82 . I OPTION="C" D
83 ..S BLDLOGIC=1
84 ..D CDUE
85 .;Dialog
86 .I OPTION="D" D
87 ..D DIALOG
88 .;Web addresses
89 .I OPTION="W" D
90 ..D WEB
91 .;If necessary build the internal logic strings.
92 .I BLDLOGIC D BLDALL^PXRMLOGX(DA,"","")
93 ;See if any changes have been made.
94 S CS2=$$FILE^PXRMEXCS(811.9,DA)
95 I CS2=0 Q
96 ;If the file has been edited, do the edit history.
97 I CS2'=CS1 D SEHIST^PXRMUTIL(811.9,DIC,DA)
98 Q
99 ;
100 ;Reminder Edit
101 ;-------------
102EDIT(ROOT,DA) ;
103 N DIC,DIDEL,DIE,DR,RESULT
104 S DIE=ROOT,DIDEL=811.9
105 ;Edit the fields in the same order they are printed by a reminder
106 ;inquiry.
107 ;Reminder name
108 W !!
109 S DR=".01"
110 D ^DIE
111 ;If DA is undefined then the entry was deleted and we are done.
112 I '$D(DA) S DTOUT=1 Q
113 I $D(Y) S DTOUT=1 Q
114 ;
115 ;Other fields
116 D GEN Q:$D(Y)
117 D BASE Q:$D(Y)
118 D FIND(.LIST) Q:$D(Y)
119 D FFIND Q:$D(Y)
120 D LOGIC Q:$D(Y)
121 D DIALOG Q:$D(Y)
122 D WEB Q:$D(Y)
123 Q
124 ;
125GEN ;Print name
126 W !!
127 S DR="1.2"
128 D ^DIE
129 I $D(Y) Q
130 ;
131CLASS ;
132 ;Class
133 W !!
134 S DR="100"
135 D ^DIE
136 I $D(Y) Q
137 ;Sponsor
138 S DR="101"
139 D ^DIE
140 I $D(Y) Q
141 ;Make sure Class and Sponsor Class are in synch.
142 S RESULT=$$VSPONSOR^PXRMINTR(X)
143 I RESULT=0 G CLASS
144 ;Review date, Usage
145 S DR="102;103"
146 D ^DIE
147 I $D(Y) Q
148 ;
149 ;Related VA-* reminder
150 W !!
151 S DR="1.4"
152 D ^DIE
153 I $D(Y) Q
154 ;
155 ;Inactive flag
156 W !!
157 S DR="1.6"
158 D ^DIE
159 I $D(Y) Q
160 ;Ignore on N/A
161 S DR=1.8
162 D ^DIE
163 I $D(Y) Q
164 ;
165 ;Recision Date
166 S DR="69"
167 D ^DIE
168 I $D(Y) Q
169 ;
170 ;Reminder description
171 W !!
172 S DR="2"
173 D ^DIE
174 I $D(Y) Q
175 ;
176 ;Technical description
177 W !!
178 S DR="3"
179 D ^DIE
180 ;
181 ;Priority
182 W !!
183 S DR="1.91"
184 D ^DIE
185 Q
186 ;
187BASE W !!,"Baseline Frequency"
188 ;Do in advance time frame
189 S DR=1.3
190 D ^DIE
191 I $D(Y) Q
192 ;
193 ;Sex specific
194 S DR=1.9
195 D ^DIE
196 I $D(Y) Q
197FARS ;
198 W !!,"Baseline frequency age range set"
199 S DR="7"
200 S DR(2,811.97)=".01;1;2;3;4"
201 D ^DIE
202 I $$OVLAP^PXRMAGE G FARS
203 D SNMLA^PXRMFNFT(DA)
204 Q
205 ;
206FIND(LIST) ;Edit findings (multiple)
207 D FIND^PXRMREDF(.LIST)
208 D SNMLF^PXRMFNFT(DA,20)
209 Q
210 ;
211FFIND W !!,"Function Findings"
212 D FFIND^PXRMREDF
213 D SNMLF^PXRMFNFT(DA,25)
214 Q
215 ;
216LOGIC W !!,"Patient Cohort and Resolution Logic"
217 S DR="30T;60T;61T;70T;71T;34T;65T;66T;75T;76T"
218 D ^DIE
219 ;Make sure the Patient Cohort Logic at least contains the default.
220 I $G(^PXD(811.9,DA,31))="" D
221 . S ^PXD(811.9,DA,31)="(SEX)&(AGE)"
222 . S ^PXD(811.9,DA,32)="2"_U_"SEX;AGE"
223 D SNMLL^PXRMFNFT(DA)
224 Q
225CDUE W !!,"Custom Date Due"
226 S DR=45
227 D ^DIE
228 Q
229 ;
230DIALOG W !!,"Reminder Dialog"
231 S DR="51"
232 D ^DIE
233 Q
234 ;
235WEB W !!,"Web Addresses for Reminder Information"
236 S DR="50"
237 D ^DIE
238 Q
239 ;
240 ;Get full list of findings
241 ;-------------------------
242LIST(GBL,DA,ARRAY) ;
243 N CNT,DATA,GLOB,IEN,NAME,NODE,SUB,TYPE
244 ;Clear passed arrays
245 K ARRAY
246 S CNT=0
247 ;Build cross reference global to file number
248 ;Get each finding
249 S SUB=0 F S SUB=$O(@GBL@(DA,20,SUB)) Q:'SUB D
250 .S DATA=$G(@GBL@(DA,20,SUB,0)) I DATA="" Q
251 .;Determine global and global ien
252 .S NODE=$P(DATA,U),GLOB=$P(NODE,";",2),IEN=$P(NODE,";")
253 .;Ignore null entries
254 .I (GLOB="")!(IEN="") Q
255 .;Work out the file type
256 .S TYPE=$G(DEF1(GLOB)) Q:TYPE=""
257 .S CNT=CNT+1
258 .I $P($G(@(U_GLOB_IEN_",0)")),U)="" D
259 ..W !,"**WARNING** Finding #"_SUB_" does not exist, select finding `"_SUB_" to edit it." Q
260 .E S NAME=$P($G(@(U_GLOB_IEN_",0)")),U) S ARRAY(TYPE,NAME,SUB)=IEN
261 .;E S NAME=$P($G(@(U_GLOB_IEN_",0)")),U) S ARRAY(TYPE,NAME,SUB)=$G(SUB)
262 Q
263 ;
264 ;Choose which part of Reminder to edit
265 ;-------------------------------------
266OPTION N DIR,X,Y
267 ;Display warning message if un-mapped terms exist
268 K DIROUT,DIRUT,DTOUT,DUOUT
269 S DIR(0)="SO"_U
270 S DIR(0)=DIR(0)_"A:All reminder details;"
271 S DIR(0)=DIR(0)_"G:General;"
272 S DIR(0)=DIR(0)_"B:Baseline Frequency;"
273 S DIR(0)=DIR(0)_"F:Findings;"
274 S DIR(0)=DIR(0)_"FF:Function Findings;"
275 S DIR(0)=DIR(0)_"L:Logic;"
276 S DIR(0)=DIR(0)_"C:Custom date due;"
277 S DIR(0)=DIR(0)_"D:Reminder Dialog;"
278 S DIR(0)=DIR(0)_"W:Web Addresses;"
279 S DIR("A")="Select section to edit"
280 S DIR("?")="Select which section of the reminder you wish to edit."
281 S DIR("??")="^D HELP^PXRMREDF(2)"
282 D ^DIR K DIR
283 I Y="" S DUOUT=1 Q
284 I $D(DIROUT) S DTOUT=1
285 I $D(DTOUT)!$D(DUOUT) Q
286 S OPTION=Y
287 Q
288 ;
289 ;-------------------------------------
290LUDISP(IEN) ;Use for DIC("W") to augment look-up display.
291 N CLASS,EM,INACTIVE,TEXT
292 S INACTIVE=$P(^PXD(811.9,IEN,0),U,6)
293 S CLASS=$P(^PXD(811.9,IEN,100),U,1)
294 I INACTIVE'="" S INACTIVE="("_$$EXTERNAL^DILFD(811.9,1.6,"",INACTIVE,.EM)_")"
295 S CLASS=$$EXTERNAL^DILFD(811.9,100,"",CLASS,.EM)
296 S TEXT=" "_CLASS_" "_INACTIVE
297 Q TEXT
298 ;
299 ;-------------------------------------
300TFIND(DA,LIST) ;Allow edit of term findings for national reminders.
301 N DIR,IENLIST,IND,JND,NAME,NAMELIST,SUB,X,Y
302 S IND=0,NAME=""
303 F S NAME=$O(LIST("RT",NAME)) Q:NAME="" D
304 . S IND=IND+1
305 . S NAMELIST(IND)=$$RJ^XLFSTR(IND,3)_" "_NAME
306 . S SUB=$O(LIST("RT",NAME,""))
307 . S IENLIST(IND)=LIST("RT",NAME,SUB)
308 M DIR("A")=NAMELIST
309 S DIR("A")="Enter your list"
310 S DIR(0)="LO^1:"_IND
311 W !!,"Select term(s) for finding edit:"
312 D ^DIR
313 I $D(DIROUT)!$D(DIRUT) S LIST="" Q
314 I $D(DUOUT)!$D(DTOUT) S LIST="" Q
315 F IND=1:1:$L(Y,",")-1 D
316 . S JND=$P(Y,",",IND)
317 . S NAME=$P(NAMELIST(JND),JND,2)
318 . W !!,"Reminder Term:",NAME
319 . D TMAP^PXRMREDF(DA,IENLIST(JND))
320 Q
321 ;
Note: See TracBrowser for help on using the repository browser.