source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXLR.m

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

revised back to 6/30/08 version
File size: 7.5 KB
Line 
1PXRMEXLR ; SLC/PKR/PJH - List Manager routines for existing repository entries. ;01/10/2003
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;==================================================
4CHF ;Create a host file containing repository entries.
5 N IND,FILE,LENH2,PATH,SUCCESS,TEMP,VALMY
6 ;Get the list to store.
7 D EN^VALM2(XQORNOD(0))
8 ;If there is no list quit.
9 I '$D(VALMY) Q
10 ;Get the host file to use.
11 D CLEAR^VALM1
12 S TEMP=$$GETHFS^PXRMEXHF
13 I TEMP=0 S VALMBCK="R" Q
14 S PATH=$P(TEMP,U,1)
15 S FILE=$P(TEMP,U,2)
16 D CHF^PXRMEXHF(.SUCCESS,.VALMY,PATH,FILE)
17 S VALMHDR(1)="Successfully stored entries"
18 S VALMHDR(2)="Failed to store entries"
19 S LENH2=$L(VALMHDR(2))
20 S IND=""
21 F S IND=$O(SUCCESS(IND)) Q:+IND=0 D
22 . I SUCCESS(IND) S VALMHDR(1)=VALMHDR(1)_" "_IND
23 . E S VALMHDR(2)=VALMHDR(2)_" "_IND
24 I $L(VALMHDR(2))=LENH2 K VALMHDR(2)
25 S VALMBCK="R"
26 Q
27 ;
28 ;==================================================
29CMM ;Create a MailMan message containing packed reminders.
30 N SUCCESS,TEMP,VALMY
31 ;Get the list to store.
32 D EN^VALM2(XQORNOD(0))
33 ;If there is no list quit.
34 I '$D(VALMY) Q
35 ;Get a new message number to store the entries in.
36 D CMM^PXRMEXMM(.SUCCESS,.VALMY)
37 I $D(SUCCESS("XMZ")) S VALMHDR(1)="Successfully stored entries in message "_SUCCESS("XMZ")_"."
38 E S VALMHDR(1)="Failed to store entries"
39 S VALMBCK="R"
40 Q
41 ;
42 ;==================================================
43DELETE ;Get a list of repository entries and delete them.
44 N COUNT,DELLIST,IEN,IND,RELIST,VALMY
45 ;Get the list to delete.
46 D MIENLIST(.DELLIST)
47 S COUNT=+$G(DELLIST("COUNT"))
48 I COUNT=0 Q
49 D DELETE^PXRMEXU1(.DELLIST)
50 ;Rebuild the list for List Manager to display.
51 K ^TMP("PXRMEXLR",$J)
52 D RE^PXRMLIST(.RELIST,.IEN)
53 M ^TMP("PXRMEXLR",$J)=RELIST
54 S VALMCNT=RELIST("VALMCNT")
55 F IND=1:1:VALMCNT S ^TMP("PXRMEXLR",$J,"IDX",IND,IND)=IEN(IND)
56 ;
57 S VALMHDR(1)="Deleted "_DELLIST("COUNT")_" Exchange File"
58 I COUNT>1 S VALMHDR(1)=VALMHDR(1)_" entries."
59 I COUNT=1 S VALMHDR(1)=VALMHDR(1)_" entry."
60 I COUNT=0 S VALMHDR(1)="No entries selected."
61 S VALMHDR(2)=" "
62 S VALMBCK="R"
63 Q
64 ;
65 ;==================================================
66DELHIST ;Get a list of repository installation entries and delete them.
67 ;Save the original list, it contains the selected repository entries.
68 N VALMYO
69 M VALMYO=VALMY
70 N IHIND,IND,RIEN,TEMP,VALMY
71 N VALMBG,VALMLST
72 ;
73 S VALMBG=1,VALMLST=+$O(^TMP("PXRMEXIH",$J,"IDX",""),-1)
74 ;Get the list to delete.
75 D EN^VALM2(XQORNOD(0))
76 ;If there is no list quit.
77 I '$D(VALMY) Q
78 S IND=""
79 F S IND=$O(VALMY(IND)) Q:IND="" D
80 . S TEMP=^TMP("PXRMEXIH",$J,"SEL",IND)
81 . S RIEN=$P(TEMP,U,1)
82 . S IHIND=$P(TEMP,U,2)
83 . D DELHIST^PXRMEXU1(RIEN,IHIND)
84 ;Rebuild the display list.
85 D HISTLIST^PXRMEXLC(.VALMYO,.VALMCNT)
86 S VALMBCK="R"
87 Q
88 ;
89 ;==================================================
90EXIT ; Exit code
91 D CLEAN^VALM10
92 D FULL^VALM1
93 S VALMBCK="R"
94 K ^TMP("PXRMEXLR",$J)
95 Q
96 ;
97 ;==================================================
98IH ;Get a list of repository entries and show their installation history.
99 N VALMCNT,VALMY
100 D EN^VALM2(XQORNOD(0))
101 ;If there is no list quit.
102 I '$D(VALMY) Q
103 ;Build a history list.
104 D HISTLIST^PXRMEXLC(.VALMY,.VALMCNT)
105 D EN^VALM("PXRM EX INSTALLATION HISTORY")
106 K ^TMP("PXRMEXIH",$J)
107 S VALMBCK="R"
108 Q
109 ;
110 ;==================================================
111INDETAIL ;Output the details of an installation.
112 N VALMBG,VALMCNT,VALMHDR,VALMLST,VALMY
113 S VALMBG=1,VALMLST=+$O(^TMP("PXRMEXIH",$J,"IDX",""),-1)
114 ;Get the list to display.
115 D EN^VALM2(XQORNOD(0))
116 ;If there is no list quit.
117 I '$D(VALMY) Q
118 D INDISP(.VALMY)
119 Q
120 ;
121 ;==================================================
122INDISP(ARRAY) ;Display details list
123 N ACTION,CMPNT,DI,DP,ENTRY,IHIND,IND,INDEX,JND,KND
124 N NAME,NEWNAME,NLINE,RIEN,TEMP
125 K ^TMP("PXRMEXID",$J)
126 ;If there are no items then quit.
127 I '$D(ARRAY) Q
128 S (IND,NLINE)=0
129 F S IND=$O(ARRAY(IND)) Q:IND="" D
130 . S TEMP=^TMP("PXRMEXIH",$J,"SEL",IND)
131 . S RIEN=$P(TEMP,U,1)
132 . S IHIND=$P(TEMP,U,2)
133 . S TEMP=^PXD(811.8,RIEN,0)
134 . S ENTRY=$E($P(TEMP,U,1),1,38)
135 . S ENTRY=$$LJ^XLFSTR(ENTRY,38," ")
136 . S DP=$$FMTE^XLFDT($P(TEMP,U,3),"5Z")
137 . S DI=$$FMTE^XLFDT(^PXD(811.8,RIEN,130,IHIND,0),"5Z")
138 . I NLINE>1 D
139 .. S NLINE=NLINE+1
140 .. S ^TMP("PXRMEXID",$J,NLINE,0)="------------------------------------------------------------------------------"
141 . S NLINE=NLINE+1
142 . S ^TMP("PXRMEXID",$J,NLINE,0)=ENTRY_" "_DP_" "_DI
143 .;Write the header line here.
144 . S NLINE=NLINE+1
145 . S ^TMP("PXRMEXID",$J,NLINE,0)=" Component Action New Name"
146 . S CMPNT=""
147 . S JND=0
148 . F S JND=$O(^PXD(811.8,RIEN,130,IHIND,1,JND)) Q:JND="" D
149 .. S TEMP=^PXD(811.8,RIEN,130,IHIND,1,JND,0)
150 .. I $P(TEMP,U,2)'=CMPNT D
151 ... S NLINE=NLINE+1
152 ... S ^TMP("PXRMEXID",$J,NLINE,0)=" "
153 ... S CMPNT=$P(TEMP,U,2)
154 ... S NLINE=NLINE+1
155 ... S ^TMP("PXRMEXID",$J,NLINE,0)=CMPNT
156 .. S INDEX=$$RJ^XLFSTR($P(TEMP,U,1),4," ")
157 .. S NAME=$E($P(TEMP,U,3),1,36)
158 .. S NAME=$$LJ^XLFSTR(NAME,36," ")
159 .. S ACTION=$P(TEMP,U,4)
160 .. S NEWNAME=$E($P(TEMP,U,5),1,36)
161 .. S NEWNAME=$$LJ^XLFSTR(NEWNAME,36," ")
162 .. S NLINE=NLINE+1
163 .. S ^TMP("PXRMEXID",$J,NLINE,0)=INDEX_" "_NAME_" "_ACTION_" "_NEWNAME
164 ..;If there are Additional Details add them to the display.
165 .. S KND=0
166 .. F S KND=$O(^PXD(811.8,RIEN,130,IHIND,1,JND,1,KND)) Q:KND="" D
167 ... S NLINE=NLINE+1
168 ... S ^TMP("PXRMEXID",$J,NLINE,0)=^PXD(811.8,RIEN,130,IHIND,1,JND,1,KND,0)
169 . S NLINE=NLINE+1
170 . S ^TMP("PXRMEXID",$J,NLINE,0)=" "
171 S VALMHDR(1)=^PXD(811.8,RIEN,0)_" "_^TMP("PXRMEXID",$J,1,0)
172 S VALMCNT=NLINE
173 D EN^VALM("PXRM EX INSTALLATION DETAIL")
174 K ^TMP("PXRMEXID",$J)
175 S VALMBCK="R"
176 Q
177 ;
178 ;==================================================
179INSTALL ;Get a list of repository entries and install them.
180 N IND,PXRMRIEN,VALMY
181 D EN^VALM2(XQORNOD(0))
182 ;If there is no list quit.
183 I '$D(VALMY) Q
184 ;PXRMDONE is newed in PXRMEXLM
185 S PXRMDONE=0
186 S IND=""
187 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
188 .;Get the repository ien.
189 . S PXRMRIEN=^TMP("PXRMEXLR",$J,"IDX",IND,IND)
190 .;The list template calls INSTALL^PXRMEXLI
191 . D EN^VALM("PXRM EX LIST COMPONENTS")
192 . K ^TMP("PXRMEXLC",$J)
193 Q
194 ;
195 ;==================================================
196HDR ; Header code
197 S VALMHDR(1)=""
198 D CHGCAP^VALM("RNAME","Reminder Name")
199 D CHGCAP^VALM("PNAME","Date Loaded")
200 Q
201 ;
202 ;==================================================
203HELP ; Help code
204 S X="?" D DISP^XQORM1 W !!
205 Q
206 ;
207 ;==================================================
208IS ;Get a list of packed reminders and print the installation summary.
209 N VALMY
210 D EN^VALM2(XQORNOD(0))
211 ;If there is no list quit.
212 I '$D(VALMY) Q
213 Q
214 ;
215 ;==================================================
216MIENLIST(LIST) ;Get a list of List Manager repository entries and turn it
217 ;into iens.
218 N COUNT,IEN,VALMY
219 D EN^VALM2(XQORNOD(0))
220 ;If there is no list quit.
221 I '$D(VALMY) Q
222 S COUNT=0
223 S IND=""
224 F S IND=$O(VALMY(IND)) Q:+IND=0 D
225 . S COUNT=COUNT+1
226 . S IEN=^TMP("PXRMEXLR",$J,"IDX",IND,IND)
227 . S LIST(IEN)=""
228 S LIST("COUNT")=COUNT
229 Q
230 ;
231 ;==================================================
232PEXIT ;PXRM EXCH INSTALLATION MENU protocol exit code
233 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
234 ;Reset after page up/down etc
235 D XQORM
236 Q
237 ;
238 ;==================================================
239XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXCH SELECT HISTORY",0))_U_"1:"_VALMCNT
240 S XQORM("A")="Select Action: "
241 Q
242 ;
243 ;==================================================
244XSEL ;PXRM EXCH SELECT HISTORY validation
245 N ARRAY,CNT,SELECT,SEL
246 S SELECT=$P(XQORNOD(0),"=",2)
247 I '$$VALID^PXRMEXLD(SELECT) S VALMBCK="R" Q
248 ;Build array of selected items
249 F CNT=1:1 S SEL=$P(SELECT,",",CNT) Q:'SEL D
250 .S ARRAY(SEL)=""
251 ;
252 ;Display Selected Histories
253 D INDISP(.ARRAY)
254 Q
Note: See TracBrowser for help on using the repository browser.