source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLPP.m@ 973

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

initial load of FOIAVistA 6/30/08 version
File size: 7.1 KB
Line 
1PXRMLPP ; SLC/PKR/PJH - Reminder Patient List Patients ;04/04/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;
4 ;Main entry point for PXRM PATIENT LIST
5START(IEN) ;
6 N CDATE,CLASS,CREATOR,INDP,INTP,LDATA,LNAME,PXRMVIEW,SNAME,SOURCE,TYPE
7 N VALMBCK,VALMBG,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
8 ;Get Patient List record and associated data.
9 S LDATA=$G(^PXRMXP(810.5,IEN,0))
10 S LNAME=$P(LDATA,U,1)
11 S CDATE=$P(LDATA,U,4)
12 S SOURCE=$P(LDATA,U,5),SNAME=""
13 ;Check if generated from #810.2
14 I SOURCE S SNAME="Extract Parameter - "_$P($G(^PXRM(810.2,SOURCE,0)),U)
15 ;If not check if generated from #810.4
16 I SNAME="" D
17 . S SOURCE=$P(LDATA,U,6)
18 . I SOURCE'="" S SNAME="List Rule - "_$P($G(^PXRM(810.4,SOURCE,0)),U)
19 ;If still no source check for created from Reminder Due Report.
20 I SNAME="" D
21 . S SOURCE=$P(LDATA,U,9)
22 . I SOURCE'="" S SNAME="Reminder Due Report"
23 ;If there still is no source then assume it was generated in the
24 ;past by a Reminder Due Report.
25 I SNAME="" S SNAME="Reminder Due Report"
26 ;Creator
27 S CREATOR=+$P(LDATA,U,7)
28 S CREATOR=$S(CREATOR>0:$$GET1^DIQ(200,CREATOR,.01),1:"None")
29 ;Type
30 S TYPE=$P(LDATA,U,8)
31 S TYPE=$$EXTERNAL^DILFD(810.5,.08,"",TYPE,.EM)
32 ;Class
33 S CLASS=$P($G(^PXRMXP(810.5,IEN,100)),U)
34 S CLASS=$S(CLASS="N":"National",CLASS="V":"VISN",1:"Local")
35 S INDP=$P(LDATA,U,11)
36 S INTP=$P(LDATA,U,12)
37 ;Default view by name.
38 S PXRMVIEW="N"
39 S VALMCNT=0
40 D EN^VALM("PXRM PATIENT LIST PATIENTS")
41 Q
42 ;
43BLDLIST(IEN) ;Build a list of all patients
44 N IND,INCINST
45 S INCINST=+$P(^PXRMXP(810.5,IEN,0),U,10)
46 I 'INCINST D CHGCAP^VALM("HEADER3","")
47 K ^TMP("PXRMLPP",$J),^TMP("PXRMLPPA",$J),^TMP("PXRMLPPI",$J)
48 D LIST(.VALMCNT,.IEN,INCINST)
49 F IND=1:1:VALMCNT D
50 .S ^TMP("PXRMLPP",$J,"IDX",IND,IND)=^TMP("PXRMLPPI",$J,IND)
51 K ^TMP("PXRMLPPI",$J)
52 Q
53DEM ;
54 D FULL^VALM1
55 D EN^PXRMPDR(IEN)
56 S VALMBCK="R"
57 Q
58 ;
59EDIT ;Edit selected patient list fields.
60 N DA,DIE,DR,TEMP
61 S DA=IEN,DIE="^PXRMXP(810.5,"
62 S DR=".01;.08"
63 I $D(^XUSEC("PXRM MANAGER",DUZ)) S DR=DR_";.07"
64 D ^DIE
65 S TEMP=^PXRMXP(810.5,IEN,0)
66 S LNAME=$P(TEMP,U,1),CREATOR=$P(TEMP,U,7),TYPE=$P(TEMP,U,8)
67 S CREATOR=$P(^VA(200,CREATOR,0),U,1)
68 D HDR^PXRMLPP
69 S VALMBCK="R"
70 Q
71 ;
72EDITOK(IEN) ;Screen for protocol PXRM PATIENT LIST EDIT, return true if
73 ;the user is permitted to edit the selected patient list.
74 I $D(^XUSEC("PXRM MANAGER",DUZ)) Q 1
75 N CREATOR
76 S CREATOR=$P(^PXRMXP(810.5,IEN,0),U,7)
77 Q $S(CREATOR=DUZ:1,1:0)
78 ;
79ENTRY ;Entry code
80 D BLDLIST(IEN)
81 D XQORM
82 Q
83 ;
84EXIT ;Exit code
85 K ^TMP("PXRMLPP",$J)
86 K ^TMP("PXRMLPPH",$J)
87 D CLEAN^VALM10
88 D FULL^VALM1
89 S VALMBCK="R"
90 Q
91 ;
92FRE(NUMBER,PNAME,DFN,DECEASED,TESTP,INST) ;Format entry number, name, primary
93 ;station and deceased, test information.
94 N TEMP,TEXT,TNAME,TSOURCE
95 S TEXT=$$RJ^XLFSTR(NUMBER,5," ")
96 S TEXT=$$SETFLD^VALM1(PNAME,TEXT,"HEADER1")
97 S TEXT=TEXT_" "_$$LJ^XLFSTR(DFN,15," ")
98 S TEMP=""
99 I DECEASED S TEMP=" (D)"
100 I TESTP S TEMP=" (T)"
101 I DECEASED,TESTP S TEMP=" (DP)"
102 S TEXT=TEXT_TEMP
103 I INST'="" S TEXT=$$SETFLD^VALM1(INST,TEXT,"HEADER3")
104 Q TEXT
105 ;
106HDR ; Header code
107 N TEXT
108 S VALMHDR(1)="List Name: "_LNAME
109 S VALMHDR(2)=" Created: "_$$FMTE^XLFDT(CDATE,"5Z")
110 S VALMHDR(2)=$$LJ^XLFSTR(VALMHDR(2),40)_"Creator: "_CREATOR
111 S VALMHDR(3)=" Class: "_CLASS
112 S VALMHDR(3)=$$LJ^XLFSTR(VALMHDR(3),40)_"Type: "_TYPE
113 S VALMHDR(4)=" Source: "_SNAME
114 S VALMHDR(5)=" Number of patients: "_VALMCNT
115 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
116 S TEXT=""
117 I INDP S TEXT=" (D=deceased)"
118 I INTP S TEXT=" (T=test)"
119 I INDP,INTP S TEXT=" (D=deceased, T=test)"
120 S TEXT="DFN"_TEXT
121 D CHGCAP^VALM("HEADER2",TEXT)
122 Q
123 ;
124HLP ;Help code
125 N ORU,ORUPRMT,SUB,XQORM
126 S SUB="PXRMLPPH"
127 D EN^VALM("PXRM PATIENT LIST HELP")
128 Q
129HSA ;Print Health Summary for all patients on list
130 D HSA^PXRMLPHS(IEN)
131 S VALMBCK="R"
132 Q
133 ;
134HSI ;Print Health Summary for selected patients.
135 ;Full Screen
136 W IORESET
137 N IND,DFN,PLNODE,PNAME,VALMY
138 D EN^VALM2(XQORNOD(0))
139 ;If there is no list quit.
140 I '$D(VALMY) Q
141 S PLNODE="PXRMLPHS"_$J_$$NOW^XLFDT
142 K ^XTMP(PLNODE)
143 S ^XTMP(PLNODE,0)=$$FMADD^XLFDT(DT,2)_U_DT_"HSI LIST"
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 DFN=^TMP("PXRMLPP",$J,"IDX",IND,IND)
148 .;DBIA #10035
149 .S PNAME=$P(^DPT(DFN,0),U,1)
150 .I PNAME="" S PNAME=DFN_" does not exist"
151 .S ^XTMP(PLNODE,PNAME)=DFN
152 D HSI^PXRMLPHS(PLNODE)
153 S VALMBCK="R"
154 Q
155 ;
156INIT ;Init
157 S VALMCNT=0
158 Q
159 ;
160LIST(VALMCNT,IEN,INCINST) ;Build a list of patients.
161 N DATA,DECEASED,DFN,IND,INST,NEXT,PNAME,SUB,TESTP
162 ;Build the ordered list.
163 S IND=0,SUB="NAME"
164 F S IND=$O(^PXRMXP(810.5,IEN,30,IND)) Q:'IND D
165 .S DATA=$G(^PXRMXP(810.5,IEN,30,IND,0)) Q:DATA=""
166 .S DFN=$P(DATA,U) Q:'DFN
167 .S DECEASED=$P(DATA,U,4)
168 .S TESTP=$P(DATA,U,5)
169 .;#DBIA 10035
170 .S PNAME=$P($G(^DPT(DFN,0)),U,1)
171 .I PNAME="" S PNAME=DFN_" does not exist"
172 .S INSTNUM=$P(DATA,U,2) S:INSTNUM="" INSTNUM="NONE"
173 .S INST=$P(DATA,U,3)
174 .;Lists built before PXRM*2*4 will only have the Institution ien.
175 .I INST="" S INST=$P(DATA,U,2)
176 .I INST="" S INST="NONE"
177 .I PXRMVIEW="I" S SUB=INST
178 .S ^TMP("PXRMLPPA",$J,SUB,PNAME,DFN)=DECEASED_U_TESTP_U_INST
179 ;Transfer to list manager array
180 S SUB="",VALMCNT=0
181 F S SUB=$O(^TMP("PXRMLPPA",$J,SUB)) Q:SUB="" D
182 .S (INST,PNAME)=""
183 .F S PNAME=$O(^TMP("PXRMLPPA",$J,SUB,PNAME)) Q:PNAME="" D
184 ..S DFN=""
185 ..F S DFN=$O(^TMP("PXRMLPPA",$J,SUB,PNAME,DFN)) Q:DFN="" D
186 ...S DATA=^TMP("PXRMLPPA",$J,SUB,PNAME,DFN)
187 ...S DECEASED=$P(DATA,U,1)
188 ...S TESTP=$P(DATA,U,2)
189 ...I INCINST S INST=$P(DATA,U,3)
190 ...S VALMCNT=VALMCNT+1
191 ...S ^TMP("PXRMLPP",$J,VALMCNT,0)=$$FRE(VALMCNT,PNAME,DFN,DECEASED,TESTP,INST)
192 ...S ^TMP("PXRMLPPI",$J,VALMCNT)=DFN
193 K ^TMP("PXRMLPPA",$J)
194 Q
195 ;
196PEXIT ;PXRM PATIENT LIST PATIENTS MENU protocol exit code
197 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
198 D XQORM
199 Q
200 ;
201USER ;
202 I $P($G(^PXRMXP(810.5,IEN,0)),U,8)="PUB" D FULL^VALM1 W !,"This option is locked for Public Lists." H 2 Q
203 D FULL^VALM1
204 D START^PXRMLPAU(IEN)
205 S VALMBCK="R"
206 Q
207 ;
208USR(IEN) ;Screen for protocol PXRM PATIENT LIST AUTH USER
209 N TYPE
210 S TYPE=$P(^PXRMXP(810.5,IEN,0),U,8)
211 ;Public lists cannot have individual user access.
212 I TYPE="PUB" Q "N"
213 Q $$ACCESS^PXRMLPU(IEN)
214 ;
215VIEW ;Select view
216 W IORESET
217 S VALMBCK="R",VALMBG=1
218 N X,Y,CODE,DIR
219 K DIROUT,DIRUT,DTOUT,DUOUT
220 S DIR(0)="S"_U_"I:Sort by Institution and Name;"
221 S DIR(0)=DIR(0)_"N:Sort by Name;"
222 S DIR("A")="TYPE OF VIEW"
223 S DIR("B")=$S(PXRMVIEW="N":"I",1:"N")
224 S DIR("?")="Select from the codes displayed."
225 D ^DIR K DIR
226 I $D(DIROUT) S DTOUT=1
227 I $D(DTOUT)!($D(DUOUT)) Q
228 ;Change display type
229 S PXRMVIEW=Y
230 ;Rebuild Workfile
231 D BLDLIST^PXRMLPP(IEN),HDR
232 Q
233 ;
234XSEL ;PXRM PATIENT LIST PATIENT SELECT validation
235 N EPIEN,DFN,SEL
236 S SEL=$P(XQORNOD(0),"=",2)
237 ;Remove trailing ,
238 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
239 ;Invalid selection
240 I SEL["," D Q
241 .W $C(7),!,"Only one item number allowed." H 2
242 .S VALMBCK="R"
243 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D Q
244 .W $C(7),!,SEL_" is not a valid item number." H 2
245 .S VALMBCK="R"
246 ;
247 ;Get the patient list ien
248 S DFN=^TMP("PXRMLPP",$J,"IDX",SEL,SEL)
249 ;Full screen mode
250 D FULL^VALM1
251 ;Print individual Health Summary
252 D HSI^PXRMLPHS(DFN)
253 S VALMBCK="R"
254 Q
255 ;
256XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM PATIENT LIST PATIENT SELECT",0))_U_"1:"_VALMCNT
257 S XQORM("A")="Select Item: "
258 Q
259 ;
Note: See TracBrowser for help on using the repository browser.