source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMSEL.m@ 701

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

initial load of WorldVistAEHR

File size: 7.5 KB
Line 
1PXRMSEL ; SLC/PJH - PXRM Selection ;01/04/2001
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;Selection screen for all dialog files
5 ;
6START(HEADER,PXRMGTYP,PXRMNAM) ;
7 N PXRMREAD,PXRMSHD,PXRMSRC,PXRMVARM
8 N VALM,VALMAR,VALMBCK,VALMBG,VALMCNT,VALMHDR,VALMSG,X,XMZ
9 S X="IORESET"
10 D ENDR^%ZISS,EN^VALM("PXRM SELECTION")
11 W IORESET
12 D KILL^%ZISS
13 Q
14 ;
15 ;Labels called from list 'PXRM SELECTION'
16 ;
17 ;Add new entry
18ADD ;
19 N ANS,ARRAY,ARRAYN,DIROUT,DIRUT,DTOUT,DUOUT
20 ;Health factor resolutions
21 I PXRMGTYP="SHFR" D Q:$D(DTOUT)!$D(DUOUT) Q:ANS="A"
22 .D ^PXRMSEL2 S:$D(DUOUT) VALMBCK="R"
23 ;Add entry
24 D ADD^PXRMGEDT(PXRMGTYP),INIT
25 Q
26 ;
27 ;Copy any dialog
28COPY D ANY^PXRMDCPY
29 D:PXRMGTYP="DLGE" INIT
30 Q
31 ;
32 ;Copy selected reminder dialog
33COPYS N DIC,DUOUT,DTOUT,DIROUT,DIRUT,X,Y
34 D SEL^PXRMDCPY(PXRMDIEN,"")
35 Q
36 ;
37 ;Change dialog view
38CHNG K PXRMBG D SEL^PXRMSEL2(.PXRMDTYP),INIT
39 Q
40 ;
41 ;Change reminder view
42CHNGR(VIEW) ;
43 S $E(PXRMVIEW)=VIEW K PXRMBG
44 D INIT
45 Q
46 ;
47 ;Toggle view name/print name
48CHNGV N VIEW
49 S VIEW=$E(PXRMVIEW,2)
50 I VIEW="P" S $E(PXRMVIEW,2)="N"
51 I VIEW="N" S $E(PXRMVIEW,2)="P"
52 D INIT
53 Q
54 ;
55 ;Change between dialog view and reminder view
56DIDL(VIEW) ;
57 K PXRMBG S PXRMGTYP=VIEW
58 D INIT
59 Q
60 ;
61EXIT ;Exit code
62 D CLEAN^VALM10,FULL^VALM1
63 S VALMBCK="Q"
64 K ^TMP("PXRMSEL",$J)
65 Q
66 ;
67HDR ; Header code
68 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
69 ;Non-Dialog options
70 I PXRMGTYP'["DLG" S VALMHDR(1)=HEADER Q
71 ;Dialog Options
72 S VALM("TITLE")=PXRMHD,VALMHDR(1)=PXRMSHD
73 Q
74 ;
75HELP ;Help code
76 N ORU,ORUPRMT,XQORM,PXRMTAG S PXRMTAG=PXRMGTYP
77 D EN^VALM("PXRM DIALOG MAIN HELP")
78 S VALMBCK="R"
79 Q
80 ;
81INIT ;Init
82 D CLEAN^VALM10
83 S VALMCNT=0
84 D BUILD
85 D XQORM
86 ;
87 ;Set header and title for dialog options
88 I PXRMGTYP["DLG" D
89 .S PXRMHD="Dialog List",PXRMSHD="DIALOG VIEW ("
90 .I PXRMGTYP="DLGE" D
91 ..I PXRMDTYP="E" S PXRMSHD=PXRMSHD_"DIALOG ELEMENTS)"
92 ..I PXRMDTYP="F" S PXRMSHD=PXRMSHD_"FORCED VALUES)"
93 ..I PXRMDTYP="G" S PXRMSHD=PXRMSHD_"DIALOG GROUPS)"
94 ..I PXRMDTYP="P" S PXRMSHD=PXRMSHD_"ADDITIONAL PROMPTS)"
95 ..I PXRMDTYP="S" S PXRMSHD=PXRMSHD_"RESULT GROUPS)"
96 ..I PXRMDTYP="T" S PXRMSHD=PXRMSHD_"RESULT ELEMENT)"
97 .I PXRMGTYP="DLG" D
98 ..S PXRMSHD=PXRMSHD_"REMINDER DIALOGS - "
99 ..I $E(PXRMVIEW,2)="N" S PXRMSHD=PXRMSHD_"SOURCE REMINDER NAME)"
100 ..I $E(PXRMVIEW,2)="P" S PXRMSHD=PXRMSHD_"SOURCE REMINDER PRINT NAME)"
101 .I PXRMGTYP="DLGR" D
102 ..S PXRMSHD="REMINDER VIEW ("
103 ..I PXRMVIEW="AN" S PXRMSHD=PXRMSHD_"ALL REMINDERS BY NAME)"
104 ..I PXRMVIEW="AP" S PXRMSHD=PXRMSHD_"ALL REMINDERS BY PRINT NAME)"
105 ..I PXRMVIEW="LN" S PXRMSHD=PXRMSHD_"LINKED REMINDERS BY NAME)"
106 ..I PXRMVIEW="LP" S PXRMSHD=PXRMSHD_"LINKED REMINDERS BY PRINT NAME)"
107 .;Restore original place
108 .S:$G(PXRMBG) VALMBG=PXRMBG
109 .S VALMHDR(1)=PXRMSHD,VALM("TITLE")=PXRMHD
110 ;
111 S VALMBCK="R"
112 Q
113 ;
114 ;
115BUILD ;Build selection list
116 ;
117 D ^PXRMSEL1
118 Q
119 ;
120LIST ;List All option
121 W IORESET
122 I PXRMGTYP["DLG" D ALL^PXRMDLST
123 I PXRMGTYP="DTAX" D ALL^PXRMTDLG
124 I PXRMGTYP="FIP" D ALL^PXRMFIP
125 I PXRMGTYP="FPAR" D ALL^PXRMFLST
126 I PXRMGTYP="RCAT" D ALL^PXRMCLST
127 I PXRMGTYP="RESN" D ALL^PXRMSLST
128 I PXRMGTYP="SHFR" D ALL^PXRMSHF
129 ;
130 N DIR S DIR(0)="E" D ^DIR
131 ;
132 D XQORM
133 S VALMBCK="R"
134 Q
135 ;
136PEXIT ;PXRM SELECTION MENU protocol exit code
137 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
138 ;Reset after page up/down etc
139 D XQORM
140 Q
141 ;
142SEL ;PXRM SELECT ITEM validation
143 N ERR,IEN,SEL
144 S VALMBCK="",SEL=+$P(XQORNOD(0),"=",2)
145 ;Invalid selection
146 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D Q
147 .W $C(7),!,SEL_" is not a valid item number." H 2
148 .S VALMBCK="R"
149 ;Valid selection
150 S IEN=$O(@VALMAR@("IDX",SEL,"")) Q:'IEN
151 S VALMBCK="Q",@PXRMNAM=IEN
152 ;Save place - reminder link only
153 I PXRMGTYP["DLG" S PXRMBG=VALMBG
154 Q
155 ;
156XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM SELECTION ITEM",0))_U_"1:"_VALMCNT
157 S XQORM("A")="Select Item: "
158 ;For finding type parameters dissallow add option
159 I ((PXRMGTYP="FPAR")&(+$G(PXRMINST)=0))!(PXRMGTYP="DTAX") D
160 .N FMENU
161 .S FMENU=$O(^ORD(101,"B","PXRM FINDING SELECTION MENU",0))_";ORD(101,"
162 .I FMENU S XQORM("HIJACK")=FMENU
163 ;For dialog edit allow extra options
164 I PXRMGTYP="DLGE" D
165 .N FMENU
166 .S FMENU=$O(^ORD(101,"B","PXRM DIALOG SELECTION MENU (DLGE)",0))_";ORD(101,"
167 .I FMENU S XQORM("HIJACK")=FMENU
168 ;For reminder dialog edit allow change view
169 I PXRMGTYP="DLG" D
170 .N FMENU
171 .S FMENU=$O(^ORD(101,"B","PXRM DIALOG SELECTION MENU (DLG)",0))_";ORD(101,"
172 .I FMENU S XQORM("HIJACK")=FMENU
173 ;Reminder to dialog link
174 I PXRMGTYP="DLGR" D
175 .N FMENU
176 .S FMENU=$O(^ORD(101,"B","PXRM DIALOG/REMINDER MENU",0))_";ORD(101,"
177 .I FMENU S XQORM("HIJACK")=FMENU
178 Q
179 ;
180 ;Select single HF or all HF's for the reminder
181 ;---------------------------------------------
182ZOPT(TYPE) ;
183 N X,Y
184 K DIROUT,DIRUT,DTOUT,DUOUT
185 S DIR(0)="S"_U_"I:Individual Health Factor;"
186 S DIR(0)=DIR(0)_"A:All Health Factors for a Selected Reminder;"
187 S DIR("A")="SELECTION OPTION"
188 S DIR("B")="I"
189 S DIR("?")="Select from the codes displayed. For detailed help type ??"
190 S DIR("??")=U_"D ZHELP^PXRMSEL(1)"
191 D ^DIR K DIR
192 I $D(DIROUT) S DTOUT=1
193 I $D(DTOUT)!($D(DUOUT)) Q
194 S TYPE=Y
195 Q
196 ;
197 ;Reminder selection
198 ;------------------
199ZREM(ARRAY) ;
200 N X,Y,CNT,FSUB,FHF,FIND,FNAM,FOUND,REM
201 K DIROUT,DIRUT,DTOUT,DUOUT
202 S FOUND=0
203 W !
204 F D Q:$D(DTOUT) Q:$D(DUOUT) Q:FOUND
205 .S DIC=811.9,DIC(0)="AEMQZ"
206 .D ^DIC K DIC S:X=(U_U) DTOUT=1 Q:$D(DTOUT)!$D(DUOUT)!(+Y=-1)
207 .;Reminder ien
208 .S REM=$P(Y,U) Q:'REM
209 .;Get health factor findings on this reminder
210 .S FSUB=0
211 .F S FSUB=$O(^PXD(811.9,REM,20,FSUB)) Q:'FSUB D
212 ..S FIND=$P($G(^PXD(811.9,REM,20,FSUB,0)),U)
213 ..Q:$P(FIND,";",2)'="AUTTHF("
214 ..S FHF=$P(FIND,";") Q:'FHF
215 ..S FNAM=$P($G(^AUTTHF(FHF,0)),U) Q:FNAM=""
216 ..;Save array used by PXRMGEDT
217 ..S FOUND=FOUND+1
218 ..S ARRAY(FNAM)=FHF,ARRAYN(FHF)=""
219 .I 'FOUND W !!,"No health factor findings on this reminder",! Q
220 .S FNAM=""
221 .W !!,"HEALTH FACTORS:",!
222 .F S FNAM=$O(ARRAY(FNAM)) Q:FNAM="" D
223 ..S FHF=$P(ARRAY(FNAM),U)
224 ..W !,FNAM W:$D(^PXRMD(801.95,FHF,0)) " (Resolution defined)"
225 .W !
226 Q
227 ;
228 ;Reminders Health Factors
229 ;------------------------
230ZSKIP N ANS,FNAM,FHF,EXISTS,TEXT
231 S FNAM=""
232 F S FNAM=$O(ARRAY(FNAM)) Q:FNAM="" D Q:$D(DUOUT)!$D(DTOUT)
233 .S FHF=ARRAY(FNAM),EXISTS=$D(^PXRMD(801.95,FHF,0))
234 .I 'EXISTS S TEXT="ADD resolution status for "_FNAM_": "
235 .I EXISTS S TEXT="MODIFY resolution status for "_FNAM_": "
236 .;Option to ADD/MODIFY
237 .D ZASK(.ANS,TEXT) Q:$D(DTOUT)!$D(DUOUT) Q:(ANS'="Y")
238 .;Force entry of HF into 801.95
239 .I 'EXISTS D
240 ..N DA,DIC,DIK,DR
241 ..;Store the unique name
242 ..S DR=".01///"_FNAM,DIE="^PXRMD(801.95,",DA=FHF
243 ..D ^DIE
244 ..;Reindex the cross-references.
245 ..S DIK="^PXRMD(801.95,",DA=FHF
246 ..D IX^DIK
247 .;Edit
248 .D EDIT^PXRMGEDT(PXRMGTYP,FHF,1)
249 Q
250 ;
251 ;Ask ADD/MODIFY or not
252 ;---------------------
253ZASK(YESNO,TEXT) ;
254 N X,Y,DIR
255 K DIROUT,DIRUT,DTOUT,DUOUT
256 S DIR(0)="YA0"
257 S DIR("A")=TEXT
258 S DIR("B")="N"
259 S DIR("?")="Enter Y or N. For detailed help type ??"
260 S DIR("??")=U_"D ZHELP^PXRMSEL(2)"
261 D ^DIR K DIR
262 I $D(DIROUT) S DTOUT=1
263 I $D(DTOUT)!($D(DUOUT)) Q
264 S YESNO=$E(Y(0))
265 Q
266 ;
267 ;General help text routine.
268 ;--------------------------
269ZHELP(CALL) ;
270 N HTEXT
271 N DIWF,DIWL,DIWR,IC
272 S DIWF="C75",DIWL=0,DIWR=75
273 ;
274 I CALL=1 D
275 .S HTEXT(1)="Enter I to select an individual health factor. Enter A to"
276 .S HTEXT(2)="process all health factor findings on a selected reminder."
277 I CALL=2 D
278 .S HTEXT(1)="Enter Yes to enter resolution status for this health"
279 .S HTEXT(2)="factor. Enter No to continue to the next health factor."
280 K ^UTILITY($J,"W")
281 S IC=""
282 F S IC=$O(HTEXT(IC)) Q:IC="" D
283 . S X=HTEXT(IC)
284 . D ^DIWP
285 W !
286 S IC=0
287 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
288 . W !,^UTILITY($J,"W",0,IC,0)
289 K ^UTILITY($J,"W")
290 W !
291 Q
Note: See TracBrowser for help on using the repository browser.