source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLPAU.m@ 1470

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

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1PXRMLPAU ; SLC/AGP - Reminder Patient List ;09/06/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 ;
4 ;Main entry point for PXRM PATIENT LIST
5START(IEN) ;
6 N PXRMDONE,VALMBCK,VALMSG,X,XMZ
7 S X="IORESET"
8 S VALMCNT=0
9 D EN^VALM("PXRM PATIENT LIST AUTH USERS")
10 W IORESET
11 Q
12 ;
13BLDLIST ;
14 N PLIST,PIEN
15 K ^TMP("PXRMLPAU",$J)
16 K ^TMP("PXRMLPAH",$J)
17 D LIST(.PLIST,.PIEN)
18 I $D(PLIST)=0 G EXIT
19 M ^TMP("PXRMLPAU",$J)=PLIST
20 S VALMCNT=PLIST("VALMCNT")
21 F IND=1:1:VALMCNT D
22 .S ^TMP("PXRMLPAU",$J,"IDX",IND,IND)=PIEN(IND)
23 Q
24 ;
25LIST(RLIST,PIEN) ;Build a list of patient list users.
26 N ACCESS,ARRAY,COUNT,DATE,DFN,IND,SIEN,FNAME,NAME,NODE,LEVEL
27 ;Build the list in alphabetical order.
28 S VALMCNT=0
29 S DFN=""
30 F S DFN=$O(^PXRMXP(810.5,IEN,40,"B",DFN)) Q:DFN="" D
31 .S IND=""
32 .F S IND=$O(^PXRMXP(810.5,IEN,40,"B",DFN,IND)) Q:'IND D
33 ..S ACCESS=$P($G(^PXRMXP(810.5,IEN,40,IND,0)),U,2)
34 ..S FNAME=$$GET1^DIQ(200,DFN,.01) Q:$G(FNAME)=""
35 ..S ARRAY(FNAME)=$G(IND)_U_$G(ACCESS)
36 I $D(ARRAY)=0 Q
37 S NAME="" F S NAME=$O(ARRAY(NAME)) Q:NAME="" D
38 .S VALMCNT=VALMCNT+1
39 .S RLIST(VALMCNT,0)=$$FRE(VALMCNT,NAME,$P($G(ARRAY(NAME)),U,2))
40 .S PIEN(VALMCNT)=$P($G(ARRAY(NAME)),U)
41 S RLIST("VALMCNT")=VALMCNT
42 Q
43 ;
44FRE(NUMBER,NAME,ACCESS) ;Format entry number, name, source,
45 ;and date packed.
46 N TEMP,TNAME,TSOURCE
47 S TEMP=$$RJ^XLFSTR(NUMBER,5," ")
48 S TNAME=$E(NAME,1,45)
49 S TEMP=TEMP_" "_TNAME
50 S TEMP=$$LJ^XLFSTR(TEMP,40," ")_ACCESS
51 Q TEMP
52 ;
53ENTRY ;Entry code
54 D BLDLIST,XQORM
55 Q
56 ;
57EXIT ;Exit code
58 K ^TMP("PXRMLPAU",$J)
59 K ^TMP("PXRMLPAH",$J)
60 D CLEAN^VALM10
61 D FULL^VALM1
62 Q
63 ;
64HDR ; Header code
65 S VALMHDR(1)="Available Patient Lists."
66 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
67 Q
68 ;
69HLP ;Help code
70 N ORU,ORUPRMT,SUB,XQORM
71 S SUB="PXRMLPAH"
72 D EN^VALM("PXRM PATIENT LIST HELP")
73 Q
74 ;
75INIT ;Init
76 S VALMCNT=0
77 Q
78 ;
79PEXIT ;PXRM MENU protocol exit code
80 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
81 ;Reset after page up/down etc
82 D XQORM
83 Q
84 ;
85ADD ;add a user
86 N CREAT,CNT,DIC,DIE,FDA,MSG,USER,Y
87 S CREAT=$P($G(^PXRMXP(810.5,IEN,0)),U,7)
88 I $G(CREAT)'=DUZ D G ADDE
89 . W !,"Only the creator of this list can add an user." H 2
90 D FULL^VALM1
91 S DIC="^VA(200,"
92 S DIC(0)="QAEB"
93 S DIC("A")="Select Users: "
94 D ^DIC
95 I Y=-1 Q
96 S USER=+Y
97 K Y
98 K DIROUT,DIRUT,DTOUT,DUOUT
99 S DIR(0)="S^F:Full Control;V:View Only"
100 S DIR("A")="Select level of control: "
101 S DIR("B")="V"
102 S DIR("?")="Enter F or V. For detailed help type ??"
103 W !
104 D ^DIR K DIR
105 I $D(DIROUT) S DTOUT=1
106 I $D(DTOUT)!($D(DUOUT)) Q
107 I $G(Y)="" W !,"A level of control must be entered." H 2 Q
108 S YESNO=$E(Y(0))
109 S FDA(810.54,"+2,"_IEN_",",.01)=USER
110 S FDA(810.54,"+2,"_IEN_",",1)=Y
111 D UPDATE^DIE("","FDA","","MSG")
112 I $D(MSG)>0 D AWRITE^PXRMUTIL("MSG") H 2
113ADDE ;
114 D BLDLIST
115 S VALMBCK="R"
116 Q
117 ;
118XQORM ;
119 S XQORM("#")=$O(^ORD(101,"B","PXRM PATIENT LIST AUTH USER SELECT",0))_U_"1:"_VALMCNT
120 S XQORM("A")="Select Item: "
121 Q
122 ;
123XSEL ;PXRM SELECT COMPONENT validation
124 N EPIEN,LISTIEN,LRIEN,SEL
125 S SEL=$P(XQORNOD(0),"=",2)
126 ;Remove trailing ,
127 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
128 ;Invalid selection
129 I SEL["," D Q
130 .W $C(7),!,"Only one item number allowed." H 2
131 .S VALMBCK="R"
132 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D Q
133 .W $C(7),!,SEL_" is not a valid item number." H 2
134 .S VALMBCK="R"
135 ;Get the patient list ien
136 S LISTIEN=^TMP("PXRMLPAU",$J,"IDX",SEL,SEL)
137 ;Full screen mode
138 D FULL^VALM1
139 D PDELETE
140 ;
141 ;Option to Install, Delete or Install History
142 ;
143 S VALMBCK="R"
144 Q
145 ;
146HELP(CALL) ;General help text routine
147 N HTEXT
148 I CALL=1 D
149 .S HTEXT(1)="Select CO to copy the patient list.\\"
150 .S HTEXT(2)="Select COE to copy the patient list to an OE/RR Team.\\"
151 .S HTEXT(3)="Select DE to delete the patient list.\\"
152 .S HTEXT(4)="Select DSP to display the patient list.\\"
153 D HELP^PXRMEUT(.HTEXT)
154 Q
155 ;
156PDELETE ;Patient list delete
157 ;
158 ;Full Screen
159 W IORESET
160 ;
161 N CREAT,IND,LISTIEN,NODE
162 I DUZ'=$P($G(^PXRMXP(810.5,IEN,0)),U,7) D G PDELEX
163 .W !,"Only the creator of this list can delete it." H 2
164 D EN^VALM2(XQORNOD(0))
165 ;If there is no list quit.
166 I '$D(VALMY) D BLDLIST S VALMBCK="R" Q
167 S IND="",PXRMDONE=0
168 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
169 .;Get the patient list ien.
170 .S LISTIEN=^TMP("PXRMLPAU",$J,"IDX",IND,IND)
171 .S DA(1)=IEN,DA=LISTIEN,DIK="^PXRMXP(810.5,"_DA(1)_",40," D ^DIK
172 .W !,"Patient list deleted"
173 ;
174PDELEX ;
175 D BLDLIST
176 ;
177 S VALMBCK="R"
178 Q
179 ;
Note: See TracBrowser for help on using the repository browser.