source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLPU.m@ 1661

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

revised back to 6/30/08 version

File size: 7.5 KB
Line 
1PXRMLPU ; SLC/PKR/PJH - Reminder Patient List ;08/07/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;Main entry point for PXRM PATIENT LIST
5START(MODE) ;
6 N PXRMDONE,VALMBCK,VALMSG,X,XMZ,MODE1
7 S X="IORESET"
8 D ENDR^%ZISS
9 S VALMCNT=0
10 D EN^VALM("PXRM PATIENT LIST USER")
11 W IORESET
12 D KILL^%ZISS
13 Q
14 ;
15ACCESS(IEN,NODE) ;
16 ;Holders of the PXRM MANAGER key have full access to all lists.
17 ;DBIA #10076
18 I $D(^XUSEC("PXRM MANAGER",DUZ)) Q "F"
19 N ACCESS,TYPE
20 I $G(NODE)="" S NODE=$G(^PXRMXP(810.5,IEN,0))
21 S TYPE=$P(NODE,U,8)
22 I TYPE="" Q "F"
23 I TYPE="PUB" Q "F"
24 I $P(NODE,U,7)=DUZ Q "F"
25 S ACCESS="N"
26 I TYPE="PVT",$D(^PXRMXP(810.5,IEN,40,"B",DUZ)) D
27 . N USIEN,STATUS
28 . S USIEN=$O(^PXRMXP(810.5,IEN,40,"B",DUZ,""))
29 . S ACCESS=$S(USIEN="":"N",1:$P(^PXRMXP(810.5,IEN,40,USIEN,0),U,2))
30 Q ACCESS
31 ;
32BLDLIST ;
33 N IEN,PLIST
34 K ^TMP("PXRMLPU",$J)
35 K ^TMP("PXRMLPUH",$J)
36 S PLIST="PXRMLPU"
37 D LIST(MODE,PLIST,.IEN)
38 S VALMCNT=+$G(^TMP("PXRMLPU",$J,"VALMCNT"))
39 F IND=1:1:VALMCNT D
40 .S ^TMP("PXRMLPU",$J,"IDX",IND,IND)=IEN(IND)
41 Q
42 ;
43ENTRY ;Entry code
44 ;MODE=0 ORDER BY NAME
45 ;MODE=1 ORDER BY TYPE
46 I $G(MODE)'>0 S MODE=0
47 D BLDLIST,XQORM
48 Q
49 ;
50EXIT ;Exit code
51 K ^TMP("PXRMLPU",$J)
52 K ^TMP("PXRMLPUH",$J)
53 D CLEAN^VALM10
54 D FULL^VALM1
55 S VALMBCK="R"
56 Q
57 ;
58FORMAT(NUMBER,NAME,NODE) ;Format entry number, name, source,
59 ;and date packed.
60 N ACCESS,DATE,COUNT,TEMP,TYPE
61 S DATE=$P(NODE,U,2),COUNT=$P(NODE,U,3)
62 S TYPE=$P(NODE,U,4),ACCESS=$P(NODE,U,5)
63 S TEMP=$$RJ^XLFSTR(NUMBER,5," ")
64 S NAME=$E(NAME,1,45)
65 S TEMP=TEMP_" "_$$LJ^XLFSTR(NAME,45," ")
66 S DATE=$$FMTE^XLFDT(DATE,2)
67 S TEMP=TEMP_" "_$$LJ^XLFSTR(DATE,17," ")
68 S TEMP=TEMP_" "_$$RJ^XLFSTR(COUNT,6," ")
69 S TEMP=TEMP_" "_$$RJ^XLFSTR(TYPE,4," ")
70 S TEMP=TEMP_" "_$$RJ^XLFSTR(ACCESS,3," ")
71 Q TEMP
72 ;
73HDR ; Header code
74 N NAME
75 S VALMHDR(1)="Available Patient Lists."
76 Q
77 ;
78HELP(CALL) ;General help text routine
79 N HTEXT
80 I CALL=1 D
81 .S HTEXT(1)="Select CO to copy patient list."
82 .S HTEXT(2)="Select COE to copy patient list to OE/RR Team."
83 .S HTEXT(3)="Select CR to delete patient list."
84 .S HTEXT(4)="Select DCD to display creation documentation."
85 .S HTEXT(5)="Select DSP to display patient list."
86 D HELP^PXRMEUT(.HTEXT)
87 Q
88 ;
89HLP ;Help code
90 N ORU,ORUPRMT,SUB,XQORM
91 S SUB="PXRMLPUH"
92 D EN^VALM("PXRM PATIENT LIST HELP")
93 Q
94 ;
95INIT ;Init
96 S VALMCNT=0
97 Q
98 ;
99LIST(MODE,PLIST,IEN) ;Build a list of patient list entries.
100 N ACCESS,COUNT,DATE,IND,FNAME,NAME,NODE,SUB,TYPE
101 ;MODE=0 build list in alphabetical order
102 ;MODE=1 build list by type of list.
103 K ^TMP($J,PLIST),^TMP(PLIST,$J)
104 S VALMCNT=0,NAME="",TYPE=""
105 F S NAME=$O(^PXRMXP(810.5,"B",NAME)) Q:NAME="" D
106 .S IND="" F S IND=$O(^PXRMXP(810.5,"B",NAME,IND)) Q:'IND D
107 ..S NODE=$G(^PXRMXP(810.5,IND,0))
108 ..S ACCESS=$$ACCESS(IND,NODE)
109 ..I ACCESS="N" Q
110 ..S FNAME=$P($G(NODE),U),DATE=$P($G(NODE),U,4)
111 ..S COUNT=+$P($G(^PXRMXP(810.5,IND,30,0)),U,4)
112 ..S TYPE=$P(NODE,U,8)
113 ..S SUB=$S(MODE=0:"NAME",1:TYPE)
114 ..S ^TMP($J,PLIST,SUB,FNAME)=IND_U_DATE_U_COUNT_U_TYPE_U_ACCESS
115 I '$D(^TMP($J,PLIST)) Q
116 ;Loop through ARRAY to populate the output list
117 ;sub is either the type of list or 'NAME'. If sort is
118 ;by TYPE show PVT lists first.
119 S SUB=""
120 F S SUB=$O(^TMP($J,PLIST,SUB),-1) Q:SUB="" D
121 .S FNAME=""
122 .F S FNAME=$O(^TMP($J,PLIST,SUB,FNAME)) Q:FNAME="" D
123 ..S NODE=^TMP($J,PLIST,SUB,FNAME),VALMCNT=VALMCNT+1
124 ..S ^TMP(PLIST,$J,VALMCNT,0)=$$FORMAT(VALMCNT,FNAME,NODE)
125 ..S IEN(VALMCNT)=$P(NODE,U,1)
126 S ^TMP(PLIST,$J,"VALMCNT")=VALMCNT
127 K ^TMP($J,PLIST)
128 Q
129 ;
130PCOPY ;Patient list copy
131 S SUB="PXRMLPU"
132 D PCOPY1(SUB)
133 D BLDLIST
134 S VALMBCK="R"
135 Q
136 ;
137PCOPY1(SUB) ;
138 ;Full Screen
139 W IORESET
140 N IND,LISTIEN,VALMY
141 D EN^VALM2(XQORNOD(0))
142 ;If there is no list quit.
143 I '$D(VALMY) Q
144 S IND="",PXRMDONE=0
145 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
146 .;Get the patient list ien.
147 .S LISTIEN=^TMP(SUB,$J,"IDX",IND,IND)
148 .D COPY^PXRMRULE(LISTIEN)
149 Q
150 ;
151PDELETE ;Patient list delete
152 ;Full Screen
153 W IORESET
154 N DELOK,IND,LISTIEN,NODE,VALMY
155 D EN^VALM2(XQORNOD(0))
156 ;If there is no list quit.
157 I '$D(VALMY) Q
158 S IND="",PXRMDONE=0
159 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
160 .;Get the patient list ien.
161 .S LISTIEN=^TMP("PXRMLPU",$J,"IDX",IND,IND)
162 .S NODE=$G(^PXRMXP(810.5,LISTIEN,0))
163 .S DELOK=$$LDELOK^PXRMEUT(LISTIEN)
164 .I DELOK D DELETE^PXRMRULE(LISTIEN) Q
165 .E D Q
166 ..W !,"In order to delete a list you must be the creator or a Reminder Manager!"
167 ..S PXRMDONE=1 H 2
168 D BLDLIST
169 S VALMBCK="R"
170 Q
171 ;
172PEXIT ;Protocol exit code
173 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
174 ;Reset after page up/down etc
175 D XQORM
176 Q
177 ;
178POERR ;Patient list copy to OERR Team (#101.21)
179 ;Full Screen
180 W IORESET
181 N ACCESS,IND,LISTIEN,NODE,USIEN,VALMY
182 D EN^VALM2(XQORNOD(0))
183 ;If there is no list quit.
184 I '$D(VALMY) Q
185 S IND="",PXRMDONE=0
186 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
187 .;Get the patient list ien.
188 .S LISTIEN=^TMP("PXRMLPU",$J,"IDX",IND,IND)
189 .S NODE=$G(^PXRMXP(810.5,LISTIEN,0))
190 .S ACCESS=$$ACCESS^PXRMLPU(LISTIEN,NODE)
191 .I ACCESS="F" D OERR^PXRMLPOE(LISTIEN)
192 .I ACCESS="N" D
193 ..W !,"The list cannot be copied; you must have full access to copy the list to an OE/RR team!"
194 ..S PXRMDONE=1 H 2
195 S VALMBCK="R"
196 Q
197 ;
198PLIST ;Patient list inquiry.
199 N CREAT,NAME,IND,LISTIEN,USIEN,VALMY,CREAT,NODE,TRUE
200 D EN^VALM2(XQORNOD(0))
201 ;If there is no list quit.
202 I '$D(VALMY) Q
203 ;PXRMDONE is newed in PXRMLPU
204 S PXRMDONE=0
205 S IND=""
206 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
207 .S LISTIEN=^TMP("PXRMLPU",$J,"IDX",IND,IND)
208 .D START^PXRMLPP(LISTIEN)
209 D BLDLIST
210 S VALMBCK="R"
211 Q
212 ;
213VIEW ;
214 D FULL^VALM1
215 N DIR,DTOUT,DUOUT,DIROUT,DIROUT,Y
216 S DIR(0)="SO^N:NAME;T:TYPE"
217 S DIR("A")="Select View Type"
218 D ^DIR
219 I $D(DTOUT),$D(DUOUT),$D(DIROUT) Q
220 I Y="N" S MODE=0 D ENTRY
221 I Y="T" S MODE=1 D ENTRY
222 Q
223 ;
224XQORM ;
225 S XQORM("#")=$O(^ORD(101,"B","PXRM PATIENT LIST USER SELECT ENTRY",0))_U_"1:"_VALMCNT
226 S XQORM("A")="Select Item: "
227 Q
228 ;
229XSEL ;SELECT validation
230 N EPIEN,LEVEL,LISTIEN,LRIEN,NODE,SEL
231 S SEL=$P(XQORNOD(0),"=",2)
232 ;Remove trailing ,
233 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
234 ;Invalid selection
235 I SEL["," D Q
236 .W $C(7),!,"Only one item number allowed." H 2
237 .S VALMBCK="R"
238 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D Q
239 .W $C(7),!,SEL_" is not a valid item number." H 2
240 .S VALMBCK="R"
241 ;
242 ;Get the patient list ien
243 S LISTIEN=^TMP("PXRMLPU",$J,"IDX",SEL,SEL)
244 ;Get extract definition ien (if present)
245 S EPIEN=$P($G(^PXRMXP(810.5,LISTIEN,0)),U,5)
246 ;Get list rule ien
247 S LRIEN=$P($G(^PXRMXP(810.5,LISTIEN,0)),U,6)
248 S NODE=$G(^PXRMXP(810.5,LISTIEN,0))
249 ;
250 ;Full screen mode
251 D FULL^VALM1
252 ;
253 ;Option to Install, Delete or Install History
254 N ACCESS,DELOK,DIR,OPTION,RIEN,X,Y
255 K DIROUT,DIRUT,DTOUT,DUOUT
256 S ACCESS=$$ACCESS(LISTIEN,NODE)
257 S DELOK=$$LDELOK^PXRMEUT(LISTIEN)
258 S DIR(0)="SBM"_U_"CO:Copy Patient List;"
259 S DIR(0)=DIR(0)_"COE:Copy to OE/RR Team;"
260 I DELOK S DIR(0)=DIR(0)_"DE:Delete Patient List;"
261 S DIR(0)=DIR(0)_"DCD:Display Creation Documentation;"
262 S DIR(0)=DIR(0)_"DSP:Display Patient List;"
263 S DIR("A")="Select Action: "
264 S DIR("B")="DSP"
265 S DIR("?")="Select from the codes displayed. For detailed help type ??"
266 S DIR("??")=U_"D HELP^PXRMLPM(1)"
267 D ^DIR K DIR
268 I $D(DIROUT) S DTOUT=1
269 I $D(DTOUT)!($D(DUOUT)) S VALMBCK="R" Q
270 S OPTION=Y
271 ;
272 I $G(OPTION)="" G XSELE
273 ;
274 ;Copy patient list
275 I OPTION="CO" D COPY^PXRMRULE(LISTIEN)
276 Q:$D(DUOUT)!$D(DTOUT)
277 ;
278 ;Copy to OE/RR Team
279 I OPTION="COE" D OERR^PXRMLPOE(LISTIEN)
280 Q:$D(DUOUT)!$D(DTOUT)
281 ;
282 ;Delete patient list
283 I OPTION="DE" D PDELETE
284 ;
285 ;Display creation documentation
286 I OPTION="DCD" D EN^PXRMLCD(LISTIEN)
287 ;
288 ;Display patient list
289 I OPTION="DSP" D START^PXRMLPP(LISTIEN)
290 ;
291XSELE ;
292 D CLEAN^VALM10
293 D BLDLIST,XQORM
294 S VALMBCK="R"
295 Q
Note: See TracBrowser for help on using the repository browser.