source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDEDT.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 8.6 KB
Line 
1PXRMDEDT ; SLC/PJH - Edit PXRM reminder dialog. ;10/18/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;
4 ;Used by protocol PXRM SELECTION ADD/PXRM GENERAL ADD
5 ;
6 ;Add Dialog
7 ;----------
8ADD N DA,DIC,Y,DTOUT,DUOUT,DTYP,DLAYGO,HED
9 S HED="ADD DIALOG"
10 W IORESET
11 F D Q:$D(DTOUT)
12 .S DIC="^PXRMD(801.41,"
13 .;Set the starting place for additions.
14 .D SETSTART^PXRMCOPY(DIC)
15 .S DIC(0)="AELMQ",DLAYGO=801.41
16 .S DIC("A")="Select DIALOG to add: "
17 .S DIC("DR")="4///"_$G(PXRMDTYP)
18 .D ^DIC
19 .I $D(DUOUT) S DTOUT=1
20 .I ($D(DTOUT))!($D(DUOUT)) Q
21 .I Y=-1 K DIC S DTOUT=1 Q
22 .I $P(Y,U,3)'=1 W !,"This dialog name already exists" Q
23 .S DA=$P(Y,U,1)
24 .;Determine dialog type
25 .S DTYP=$P($G(^PXRMD(801.41,DA,0)),U,4)
26 .;Enter dialog type if a new entry
27 .I DTYP="" D Q:$D(Y)
28 ..N DIE,DR
29 ..S DIE=801.41,DR=4
30 ..D ^DIE
31 .;
32 .;Edit Dialog
33 .D EDIT(DTYP,DA,0)
34 Q
35 ;
36 ;called by protocol PXRM DIALOG EDIT
37 ;-----------------------------------
38EDIT(TYP,DA,OIEN) ;
39 Q:'$$LOCK(DA)
40 W IORESET
41 N CS1,CS2,D1,DIC,DIDEL,DIE,DR,DTOUT,DUOUT,DINUSE,TYP,ODA,Y
42 ;Save checksum
43 S VALMBCK=""
44 S CS1=$$FILE^PXRMEXCS(801.41,DA)
45 ;
46 ;Check dialog type
47 S TYP=$P($G(^PXRMD(801.41,DA,0)),U,4)
48 S DIE="^PXRMD(801.41,",DIDEL=801.41,DINUSE=0,ODA=DA
49 ;Reminder Dialog
50 I TYP="R" S DR="[PXRM EDIT REMINDER DIALOG]"
51 ;Dialog Element
52 I TYP="E" S DR="[PXRM EDIT ELEMENT]"
53 ;Additional Prompt
54 ;I TYP="P" S DR="[PXRM EDIT PROMPT]"
55 ;Forced Value
56 I TYP="F" S DR="[PXRM EDIT FORCED VALUE]"
57 ;Dialog Group (Finding item dialog)
58 I TYP="G" S DR="[PXRM EDIT GROUP]" ;S VALMBCK="R"
59 ;Result Group
60 I TYP="S" S DR="[PXRM RESULT GROUP]"
61 ;Result Element
62 I TYP="T" S DR="[PXRM RESULT ELEMENT]"
63 ;Allows limited edit of national dialogs
64 I $P($G(^PXRMD(801.41,DA,100)),U)="N" D
65 .I TYP="T",+$P($G(^PXMRD(801.41,DA,100)),U,4)=0 Q
66 .I $G(PXRMINST)=1,DUZ(0)="@" Q
67 .S DR="[PXRM EDIT NATIONAL DIALOG]",DINUSE=1
68 ;
69 I "GEPF"[TYP D
70 .I '$D(^PXRMD(801.41,"AD",DA)) W !,"Not used by any other dialog",! Q
71 .I PXRMGTYP'="DLG" S DINUSE=1 Q
72 .I PXRMGTYP="DLG" D Q
73 ..N SUB
74 ..S SUB=0
75 ..F S SUB=$O(^PXRMD(801.41,"AD",DA,SUB)) Q:'SUB Q:DINUSE D
76 ...I SUB'=PXRMDIEN S DINUSE=1
77 I DINUSE D
78 .W !,"Current dialog element/group name: "_$P($G(^PXRMD(801.41,DA,0)),U)
79 .I TYP="S" Q
80 .I PXRMGTYP="DLGE" D
81 ..W !,"Used by:" D USE^PXRMDLST(DA,10,"")
82 ..I $D(^PXRMD(801.41,"R",DA))'>0 Q
83 ..W !,"Used as a Replacement Element/Group for: " D REPLACE^PXRMDLST(DA,10,"")
84 .I PXRMGTYP'="DLGE" D
85 ..W !,"Used by:" D USE^PXRMDLST(DA,10,PXRMDIEN)
86 ..I $D(^PXRMD(801.41,"R",DA))'>0 Q
87 ..W !,"Used as a Replacement Element/Group for: " D REPLACE^PXRMDLST(DA,10,PXRMDIEN)
88 ;
89 ;Save list of components
90 N COMP D COMP^PXRMDEDX(DA,.COMP)
91 ;Edit dialog then unlock
92 I TYP'="P" D ^DIE D UNLOCK(ODA) I $G(DA)="",$G(OIEN)>0 D
93 .S DA=OIEN,DR="118////@" D ^DIE K DA
94 I TYP="P" D PROMPT(DA) D UNLOCK(ODA)
95 I '$D(DUOUT)&($G(D1)'="") D Q
96 . I $P($G(^PXRMD(801.41,DA,10,D1,0)),U,2)="" D Q
97 . . S DA(1)=DA,DA=D1 Q:'DA
98 . . S DIK="^PXRMD(801.41,"_DA(1)_",10,"
99 . . D ^DIK
100 . . S VALMBG=1
101 I '$D(DA) D Q
102 .;Clear any pointers from #811.9
103 .I $D(PXRMDIEN) D PURGE(PXRMDIEN)
104 .;Option to delete components
105 .I $D(COMP) D DELETE^PXRMDEDX(.COMP)
106 .S VALMBCK="R"
107 ;
108 ;Update edit history
109 I (TYP'="R") D
110 .S CS2=$$FILE^PXRMEXCS(801.41,DA) Q:CS2=CS1 Q:+CS2=0
111 .S DIC="^PXRMD(801.41,"
112 .D SEHIST^PXRMUTIL(801.41,DIC,DA)
113 ;
114 ;Redisplay changes (reminder dialog option only)
115 I PXRMGTYP="DLG",TYP="R" D
116 .;Get name of reminder dialog again
117 .S Y=$P($G(^PXRMD(801.41,DA,0)),U)
118 .;Format headings to include dialog name
119 .S PXRMHD="REMINDER DIALOG NAME: "_$P(Y,U)
120 .;Check if the set is disable and add to header if disabled
121 .I $P(^PXRMD(801.41,DA,0),U,3)]"" S PXRMHD=PXRMHD_" (DISABLED)"
122 .;Reset header in case name has changed
123 .S VALMHDR(1)=PXRMHD
124 Q
125 ;
126 ;Add SINGLE dialog element (protocol PXRM DIALOG SELECTION ITEM)
127 ;-------------------------
128ESEL(PXRMDIEN,SEL) ;
129 N DA,DIC,DLAYGO,DNEW,DTOUT,DUOUT,DTYP,Y
130 ;
131 S DIC="^PXRMD(801.41,"
132 S DLAYGO="801.41"
133 ;Set the starting place for additions.
134 D SETSTART^PXRMCOPY(DIC)
135 S DIC(0)="AEMQL"
136 S DIC("A")="Select new DIALOG ELEMENT: "
137 S DIC("S")="I ""EG""[$P(^PXRMD(801.41,Y,0),U,4)"
138 S DIC("DR")="4///E"
139 W !
140 D ^DIC
141 I $D(DUOUT) S DTOUT=1
142 I ($D(DTOUT))!($D(DUOUT)) Q
143 I Y=-1 K DIC S DTOUT=1 Q
144 S DA=$P(Y,U,1) Q:'DA
145 S DNEW=$P(Y,U,3)
146 ;Group points to itself
147 I 'DNEW,$$VGROUP(DA,PXRMDIEN) Q
148 ;Add to dialog
149 D EADD(SEL,DA,PXRMDIEN)
150 ;Determine dialog type
151 S DTYP=$P($G(^PXRMD(801.41,DA,0)),U,4)
152 ;
153 ;Edit Dialog
154 I DNEW D EDIT(DTYP,DA)
155 Q
156 ;
157 ;Update dialog component multiple
158 ;--------------------------------
159EADD(SEL,NSUB,PXRMDIEN) ;
160 N DA,DATA,NEXT
161 S DATA=$G(^PXRMD(801.41,PXRMDIEN,10,0)),NEXT=$P(DATA,U,3)+1
162 I DATA="" S DATA="^801.412IA"
163 S DA=NSUB,DA(1)=PXRMDIEN
164 S ^PXRMD(801.41,PXRMDIEN,10,NEXT,0)=SEL_U_DA_"^^^^^^^"
165 ;Update next slot
166 S $P(DATA,U,4)=$P(DATA,U,4)+1,$P(DATA,U,3)=NEXT
167 S ^PXRMD(801.41,PXRMDIEN,10,0)=DATA
168 ;Re-index
169 N DIK,DA S DIK="^PXRMD(801.41,",DA=PXRMDIEN
170 D IX^DIK
171 Q
172 ;
173 ;Change Dialog Element Type
174 ;--------------------------
175NTYP(TYP) ;
176 N X,Y,DIR K DIROUT,DIRUT,DTOUT,DUOUT
177 S DIR(0)="SA"_U_"E:Element;"
178 S DIR(0)=DIR(0)_"G:Group;"
179 S DIR("A")="Dialog Element Type: "
180 S DIR("B")="E"
181 S DIR("?")="Select from the codes displayed. For detailed help type ??"
182 S DIR("??")=U_"D HELP^PXRMDEDT(3)"
183 D ^DIR K DIR
184 I $D(DIROUT) S DTOUT=1
185 I $D(DTOUT)!($D(DUOUT)) Q
186 S TYP=Y
187 Q
188 ;
189 ;Clear pointers from the reminder file and process ID file
190 ;---------------------------------------------------------
191PURGE(DIEN) ;
192 ;Purge pointers to this dialog from reminder file
193 N RIEN
194 S RIEN=0
195 F S RIEN=$O(^PXD(811.9,"AG",DIEN,RIEN)) Q:'RIEN D
196 .K ^PXD(811.9,RIEN,51),^PXD(811.9,"AG",DIEN,RIEN)
197 ;
198 Q
199 ;
200VGROUP(DA,IEN) ;Check dialog index to see if group will point to itself
201 N FOUND
202 S FOUND=0
203 ;
204 ;Only do check if dialog is a group
205 I $P($G(^PXRMD(801.41,DA,0)),U,4)'="G" Q FOUND
206 ;
207 ;Group cannot be added to itself
208 I DA=IEN D Q FOUND
209 .S FOUND=1
210 .W !,"A group cannot be added to itself" H 2
211 ;
212 ;IEN is the dialog group being added to
213 D VGROUP1(DA,IEN)
214 Q FOUND
215 ;
216VGROUP1(DA,DIEN) ;Examine all parent dialogs
217 ;
218 ;End search if already found
219 Q:FOUND
220 ;
221 ;Check if dialog being added is a parent at this level
222 I $D(^PXRMD(801.41,"AD",DIEN,DA)) D Q
223 .S FOUND=1
224 .W !,"A group cannot be added as it's own descendant" H 2
225 ;
226 ;If not look at other parents
227 N SUB
228 S SUB=0
229 F S SUB=$O(^PXRMD(801.41,"AD",DIEN,SUB)) Q:'SUB D Q:FOUND
230 .;Ignore reminder dialogs
231 .I $P($G(^PXRMD(801.41,SUB,0)),U,4)'="G" Q
232 .;Repeat check on other parents
233 .D VGROUP1(DA,SUB)
234 Q
235 ;
236HELP(CALL) ;General help text routine
237 N HTEXT
238 N DIWF,DIWL,DIWR,IC
239 S DIWF="C70",DIWL=0,DIWR=70
240 ;
241 I CALL=1 D
242 .S HTEXT(1)="Select E to edit dialog element. If you wish to create"
243 .S HTEXT(2)="a new dialog element just for this reminder dialog select"
244 .S HTEXT(3)="C to copy and replace the current element. Select D to"
245 .S HTEXT(4)="delete the sequence number/element from the dialog."
246 I CALL=2 D
247 .S HTEXT(1)="Enter Y to copy the current dialog element to a new name"
248 .S HTEXT(2)="and then use this new element in the reminder dialog."
249 I CALL=3 D
250 .S HTEXT(1)="Enter G to change the current dialog element into a dialog"
251 .S HTEXT(2)="group so that additional elements can be added. Enter E to"
252 .S HTEXT(3)="leave the type of the dialog element unchanged."
253 I CALL=4 D
254 .S HTEXT(1)="Enter Y to change the dialog prompt created into a forced"
255 .S HTEXT(2)="value. To edit the new forced value switch to the forced"
256 .S HTEXT(3)="value screen using CV. This option only applies to prompts"
257 .S HTEXT(4)="which update PCE or vitals."
258 .S HTEXT(5)="Enter N to leave the dialog prompt unchanged."
259 K ^UTILITY($J,"W")
260 S IC=""
261 F S IC=$O(HTEXT(IC)) Q:IC="" D
262 . S X=HTEXT(IC)
263 . D ^DIWP
264 W !
265 S IC=0
266 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
267 . W !,^UTILITY($J,"W",0,IC,0)
268 K ^UTILITY($J,"W")
269 W !
270 Q
271 ;
272LOCK(DA) ;Lock the record
273 N OK
274 S OK=1
275 I '$$VEDIT^PXRMUTIL("^PXRMD(801.41,",DA) D
276 .N DTYP
277 .S DTYP=$P($G(^PXRMD(801.41,DA,0)),U,4)
278 .;Allow limit edit of Result Elements that are not lock
279 .I DTYP="T",+$P($G(^PXRMD(801.41,DA,100)),U,4)=0 Q
280 .;Allow edit of findings but not component multiple on groups
281 .I DTYP="G",$G(PXRMDIEN),DA'=PXRMDIEN Q
282 .I DTYP="G",$G(PXRMGTYP)="DLGE" Q
283 .;Allow edit of element findings
284 .I DTYP="E" Q
285 .S OK=0
286 .W !!,?5,"VA- and national class reminder dialogs may not be edited" H 2
287 I 'OK Q 0
288 ;
289 L +^PXRMD(801.41,DA):0 I Q 1
290 E W !!,?5,"Another user is editing this file, try later" H 2 Q 0
291 ;
292PROMPT(IEN) ;
293 N DIE,DR
294 S DIE="^PXRMD(801.41,",DA=IEN
295 S DR=".01;3;100;101;102;24;23;21"
296 S IEN=$G(^PXRMD(801.41,IEN,46)) I $G(IEN)="" G EX
297 I $P($G(^PXRMD(801.42,IEN,0)),U)="COM" S DR=DR_";45"
298EX ;
299 D ^DIE
300 Q
301 ;
302UNLOCK(DA) ;Unlock the record
303 L -^PXRMD(801.41,DA)
304 Q
Note: See TracBrowser for help on using the repository browser.