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

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

initial load of WorldVistAEHR

File size: 7.8 KB
Line 
1PXRMXSU ; SLC/PJH - Reminder Reports DIC Prompts;01/06/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;Called by PXRMXD
5 ;
6 ;Exits from SEL subroutine
7QUIT() I $D(DTOUT)!$D(DUOUT) Q 1
8 ;Only one entry allowed
9 I ONE="D",(CNT>0) Q 1
10 ;Mandatory entry
11 I Y=-1,(CHECK=3)!(CNT>0) Q 1
12 ;Categories may already contain reminders
13 I Y=-1,CHECK=2,$D(REMCAT) Q 1
14 ;Otherwise
15 Q 0
16 ;
17 ;Repeated Prompt using DIC
18 ;-------------------------
19SEL(FILE,MODE,CNT,ARRAY,ONE,CHECK) ;
20 ;
21 ; ONE = only allows one entry
22 ; CHECK = number or null - validation of facility
23 ;
24 N X,Y,ARRAYN
25 K DIROUT,DIRUT,DTOUT,DUOUT
26 W !
27 F D Q:$$QUIT
28 .S DIC=FILE,DIC(0)=MODE
29 .; Set up ^DIC("S") for duplicate check
30 .S DIC("S")="I '$D(ARRAYN(+Y))"
31 .I CHECK=1 D FACT^PXRMXAP
32 .I CHECK=2 S DIC("S")=DIC("S")_",'(+$P(^(0),U,6))"
33 .I CHECK=3 S DIC("S")=DIC("S")_",$$OK^PXRMXS1(+Y)"
34 .I CHECK=4 S DIC("S")=DIC("S")_",$P($G(^PXRMXP(810.5,+Y,30,0)),U,3)>0"
35 .I CHECK=5 S DIC("S")=DIC("S")_",$P($G(^OR(100.21,+Y,10,0)),U,3)>0"
36 .I CNT>0 S DIC("A")=LIT
37 .D ^DIC
38 .I X=(U_U) S DTOUT=1
39 .I $D(DTOUT)!$D(DUOUT) Q
40 .I +Y'=-1 D Q
41 ..I $D(ARRAYN(+Y)) W !,"Error - Duplicate entry" Q
42 ..S CNT=CNT+1,ARRAY(CNT)=Y_U_Y(0,0)_U_$P(Y(0),U,3)
43 ..S ARRAYN(+Y)=""
44 .I CNT=0,'$$QUIT W !,LIT1
45 .K DIC
46 Q
47 ;
48 ;Establish the LOCATION criteria
49LOC(ADEF,BDEF) ;
50 N X,Y,DIR
51LOC0 K DIROUT,DIRUT,DTOUT,DUOUT
52 S DIR(0)="S"_U_"HA:All Outpatient Locations;"
53 S DIR(0)=DIR(0)_"HAI:All Inpatient Locations;"
54 S DIR(0)=DIR(0)_"HS:Selected Hospital Locations;"
55 S DIR(0)=DIR(0)_"CA:All Clinic Stops(with encounters);"
56 S DIR(0)=DIR(0)_"CS:Selected Clinic Stops;"
57 S DIR(0)=DIR(0)_"GS:Selected Clinic Groups;"
58 S DIR("A")=ADEF
59 S DIR("B")=BDEF
60 S DIR("?")="Select from the codes displayed. For detailed help type ??"
61 S DIR("??")=U_"D HELP^PXRMXHLP(8)"
62 D ^DIR K DIR
63 I $D(DIROUT) S DTOUT=1
64 I $D(DTOUT)!($D(DUOUT)) Q
65 S PXRMLCSC=Y_U_Y(0)
66 ;If locations are to be selected individually get the list.
67 I Y="HS" D HLOC Q:$D(DTOUT) G:$D(DUOUT) LOC0
68 I Y="CS" D CSTOP Q:$D(DTOUT) G:$D(DUOUT) LOC0
69 I Y="GS" D CGRP(.PXRMCGRP) Q:$D(DTOUT) G:$D(DUOUT) LOC0
70 Q
71 ;
72 ;Build a list of hospital locations
73HLOC N IEN,SC,X,Y,CHECK
74 K DTOUT,DUOUT
75 S NHL=0
76 S DIC("A")="LOCATION: "
77 W !
78 F D Q:$D(DTOUT) Q:$D(DUOUT) Q:(Y=-1)&(NHL>0)
79 .S DIC="^SC("
80 .S DIC(0)="AEQMZ"
81 .I NHL>0 S DIC("A")="Select another LOCATION: "
82 .D ^DIC
83 .I X=(U_U) S DTOUT=1
84 .I $D(DTOUT)!($D(DUOUT)) Q
85 .I +Y'=-1 D
86 ..S IEN=$P(Y,U,1)
87 ..;Check Facility code
88 ..N FACILITY S FACILITY=$$FACL^PXRMXAP(IEN)
89 ..I FACILITY="" W !,"Location has no facility code" Q
90 ..I '$D(PXRMFACN(FACILITY)) D Q
91 ...W !,"Location has a different facility code" Q
92 ..;Check for duplicates
93 ..I (NHL>0),$$DUP(IEN,.PXRMLCHL,2) W !,"Error - Duplicate entry" Q
94 ..S NHL=NHL+1
95 ..;Get the stop code.
96 ..S X=$P(^SC(IEN,0),U,7)
97 ..S SC="Unknown" I +X>0 S SC=$P(^DIC(40.7,X,0),U,2) ; DBIA #557
98 ..I $L(SC)=0 S SC="Unknown"
99 ..;Save the external form of the name, then IEN, and the stop code.
100 ..S PXRMLCHL(NHL)=$P(Y(0,0),U,1)_U_IEN_U_SC
101 ..;Check for mixed inpatient and outpatient locations
102 ..I (NHL>1),$D(CHECK)=0 D
103 ...Q:'$$LOCN^PXRMXAP(.PXRMLCHL)
104 ...W !,"Inpatient and Outpatient locations have been selected"
105 ...S CHECK="DONE"
106 .K DIC
107 .I (NHL=0)&(+Y=-1) W !,"You must select a hospital location!"
108 ;
109 I $D(DUOUT)!($D(DTOUT)) Q
110 ;Sort the hospital location list into alphabetical order.
111 S NHL=$$SORT(NHL,"PXRMLCHL",2)
112 ;Build array by IEN
113 S IC=""
114 F S IC=$O(PXRMLCHL(IC)) Q:IC'>0 D
115 .S PXRMLOCN($P(PXRMLCHL(IC),U,2))=IC
116 Q
117 ;---
118FACILITY(SEL) ;Select facility (COPIED EX- PXRR)
119 N IC,STATION,X,Y,DIC
120 K DIRUT,DTOUT,DUOUT
121 S NFAC=0
122 S DIC("B")=+$P($$SITE^VASITE,U,3)
123 S DIC("A")="Select FACILITY: "
124 W !
125 F D Q:$D(DTOUT) Q:$D(DUOUT) Q:(Y=-1)&(NFAC>0)
126 .S DIC=4
127 .S DIC(0)="AEMQZ"
128 .I NFAC>0 S DIC("A")="Select another FACILITY: "
129 .D ^DIC
130 .I X=(U_U) S DTOUT=1
131 .I '$D(DTOUT),('$D(DUOUT)),+Y'=-1 D
132 ..;Check for duplicates
133 ..I (NFAC>0),$$DUP($P(Y,U,1),.PXRMFAC,1) W !,"Error - Duplicate entry" Q
134 ..S NFAC=NFAC+1,PXRMFAC(NFAC)=Y_U_Y(0,0)
135 .K DIC
136 ;
137 I $D(DTOUT)!$D(DUOUT) Q
138 ;;Save the facility names and station.
139 F IC=1:1:NFAC D
140 .S X=$P(PXRMFAC(IC),U,1)
141 .S STATION=$P($G(^DIC(4,X,99)),U,1)
142 .S PXRMFACN(X)=$P(PXRMFAC(IC),U,2)_U_STATION
143 ;Sort the facility list into alphabetical order.
144 S NFAC=$$SORT(NFAC,"PXRMFAC",2)
145 Q
146 ; ---
147CGRP(TEMP) ; Clinic Group Selection
148 N LIT,LIT1,DIC
149 S DIC("A")="Select CLINIC GROUP: ",NOTM=0
150 S LIT="Select another CLINIC GROUP: "
151 S LIT1="You must select a clinic group!"
152 D SEL(409.67,"AEQMZ",.NOTM,.TEMP,"","")
153 ;Build array by IEN
154 S NCGRP=0 N IC S IC=""
155 F S IC=$O(PXRMCGRP(IC)) Q:IC="" D
156 .S PXRMCGRN($P(PXRMCGRP(IC),U,1))=IC,NCGRP=IC
157 Q
158 ; ---
159LIST(TEMP) ; Patient List
160 N LIT,LIT1,DIC,NLIST
161 S DIC("A")="Select REMINDER PATIENT LIST: ",NLIST=0
162 S DIC("?")="Select a patient list to run the reminder report against."
163 S LIT="Select another PATIENT LIST: ",LIT1="You must select a list!"
164 D SEL(810.5,"AEQMZ",.NLIST,.TEMP,"",4)
165 Q
166 ;
167 ; ---
168PCMM(TEMP) ; PCMM teams
169 N LIT,LIT1,DIC
170 S DIC("A")="Select PCMM TEAM: ",NOTM=0
171 S LIT="Select another PCMM TEAM: ",LIT1="You must select a team!"
172 D SEL(404.51,"AEQMZ",.NOTM,.TEMP,"",1)
173 Q
174 ; ---
175OERR(TEAM) ; OE/RR teams
176 N LIT,LIT1,DIC
177 S DIC("A")="Select TEAM: ",NOTM=0
178 S LIT="Select another TEAM: ",LIT1="You must select a team!"
179 D SEL(100.21,"AEQMZ",.NOTM,.TEAM,"",5)
180 Q
181 ; ---
182RCAT(REMCAT,REM) ;Reminder Category/Reminder selection
183 N CAT,DIC,LIT,LIT1,SEQ
184 S NCAT=0 K REMCAT,REM
185 ;Reminder Category
186RCATS I PXRMREP="S" D Q:$D(DUOUT)!$D(DTOUT)
187 .K REMCAT S NCAT=0
188 .S DIC("A")="Select a REMINDER CATEGORY: "
189 .S LIT="Select another REMINDER CATEGORY: ",LIT1=""
190 .D SEL(811.7,"AEQMZ",.NCAT,.REMCAT,PXRMREP,3)
191 ;Individual Reminders
192 D REM(.REM) Q:$D(DTOUT)
193 I $D(DUOUT),PXRMREP="S" G RCATS
194 Q
195 ; ---
196REM(REM) ;Reminders selection
197 N LIT,LIT1,DIC
198 K REM S NREM=0
199 S DIC("A")="Select individual REMINDER: "
200 S LIT="Select another REMINDER: ",LIT1="You must select a reminder!"
201 D SEL(811.9,"AEQMZ",.NREM,.REM,PXRMREP,2)
202 Q
203 ; ---
204PAT(VAR) ; Patient select
205 N LIT,LIT1,DIC
206 S DIC("A")="Select PATIENT: ",NPAT=0
207 S LIT="Select another PATIENT: ",LIT1="You must select a patient!"
208 D SEL(2,"AEQMZ",.NPAT,.VAR,"","")
209 ;Sort the patient list into ascending order.
210 S NPAT=$$SORT(NPAT,"VAR")
211 Q
212 ; ---
213PROV(PRV) ;Build a list of selected providers.
214 N LIT,LIT1,DIC
215 S DIC("A")="Select PROVIDER: ",NPRV=0
216 S LIT="Select another PROVIDER: ",LIT1="You must select a provider!"
217 D SEL(200,"AEQMZ",.NPRV,.PRV,"","")
218 I $D(DTOUT)!($D(DUOUT)) Q
219 ;Sort the provider list into ascending order.
220 S NPRV=$$SORT(NPRV,"PRV")
221 Q
222 ; ---
223CSTOP ;Get a list of clinic stop codes.
224 N LIT,LIT1,DIC,X,Y
225 K DIROUT,DIRUT,DTOUT,DUOUT
226 S DIC("A")="Select CLINIC STOP: "
227 S LIT="Select another CLINIC STOP: "
228 S LIT1="You must select a clinic stop!"
229 S NCS=0
230 W !
231 F D Q:$D(DTOUT) Q:$D(DUOUT) Q:(Y=-1)&(NCS>0)
232 .S DIC=40.7,DIC(0)="AEMQZ"
233 .I NCS>0 S DIC("A")=LIT
234 .D ^DIC
235 .I X=(U_U) S DTOUT=1
236 .I '$D(DTOUT),('$D(DUOUT)) D
237 ..I +Y'=-1 D Q
238 ...S NCS=NCS+1
239 ...;Save the external form of the name, the IEN, and the stop code.
240 ...S PXRMCS(NCS)=$P(Y(0,0),U,1)_U_$P(Y,U,1)_U_$P(Y(0),U,2)
241 ..W:NCS=0 !,LIT1
242 ;Sort the clinic stop list into alphabetical order.
243 S NCS=$$SORT(NCS,"PXRMCS",2)
244 ;Build array by IEN
245 S IC=""
246 F S IC=$O(PXRMCS(IC)) Q:IC="" D
247 .S PXRMCSN($P(PXRMCS(IC),U,2))=IC
248 Q
249 ; ---
250SORT(N,ARRAY,KEY) ;Sort an ARRAY with N elements
251 ;return the number of unique elements. KEY is the piece of ARRAY on
252 ;which to base the sort. The default is the first piece.
253 ;
254 K ^TMP($J,"SORT")
255 I (N'>0)!(N=1) Q N
256 N IC,IND
257 I '$D(KEY) S KEY=1
258 F IC=1:1:N S ^TMP($J,"SORT",$P(@ARRAY@(IC),U,KEY))=@ARRAY@(IC)
259 S IND=""
260 F IC=1:1 S IND=$O(^TMP($J,"SORT",IND)) Q:IND="" D
261 .S @ARRAY@(IC)=^TMP($J,"SORT",IND)
262 K ^TMP($J,"SORT")
263 Q IC-1
264 ;
265 ;Check for duplicate entries
266DUP(VALUE,ARRAY,PIECE) ;
267 N IC,DUP
268 S IC=0,DUP=0
269 F S IC=$O(ARRAY(IC)) Q:IC="" D Q:DUP
270 .I $P(ARRAY(IC),U,PIECE)=VALUE S DUP=1
271 Q DUP
Note: See TracBrowser for help on using the repository browser.