source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLPU.m@ 677

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

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