source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDEDT.m@ 1006

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

revised back to 6/30/08 version

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