source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMREDT.m@ 1259

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

revised back to 6/30/08 version

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