source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXLM.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1PXRMEXLM ; SLC/PKR/PJH - Clinical Reminder Exchange List Manager routines. ;10/11/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;
4 ;=====================================================
5CRE ;Create a packed reminder and store it in the repository.
6 N RTP,SUCCESS,TMPIND
7 K VALMHDR
8 S RTP=$$GETREM^PXRMEXPU("pack")
9 I +RTP'>0 D Q
10 . S VALMHDR(1)="No reminder selected!"
11 . S VALMBCK="R"
12 S TMPIND="PXRMEXPR"
13 D PACK^PXRMEXPR(RTP,TMPIND)
14 D STOREPR^PXRMEXU2(.SUCCESS,RTP,TMPIND,"REMINDER")
15 I SUCCESS D
16 . S VALMHDR(1)="Packed reminder for "_$P(RTP,U,2)
17 . S VALMHDR(2)="was saved in Exchange File."
18 . D BLDLIST^PXRMEXLC(1)
19 E D
20 . S VALMHDR(1)="Creation of packed reminder for "_$P(RTP,U,2)
21 . S VALMHDR(2)="failed; it was not saved!"
22 S VALMBCK="R"
23 Q
24 ;
25 ;=====================================================
26DEFINQ ;Reminder definition inquiry.
27 N GBL,IEN,PXRMROOT,VALMCNT
28 S GBL="^TMP(""PXRMRINQ"",$J)"
29 S GBL=$NA(@GBL)
30 S PXRMROOT="^PXD(811.9,"
31 S IEN=$$SELECT^PXRMINQ(PXRMROOT,"Select Reminder Definition: ","")
32 S IEN=$P(IEN,U,1)
33 I IEN=-1 S VALMBCK="R" Q
34 K ^TMP("PXRMRINQ",$J)
35 D REMVAR^PXRMINQ(GBL,IEN)
36 S VALMCNT=$O(^TMP("PXRMRINQ",$J,""),-1)
37 D EN^VALM("PXRM EX DEFINITION INQUIRY")
38 K ^TMP("PXRMRINQ",$J)
39 S VALMBCK="R"
40 Q
41 ;
42 ;=====================================================
43ENTRY ;Entry code
44 D BLDLIST^PXRMEXLC(0)
45 D XQORM
46 Q
47 ;
48 ;=====================================================
49EXIT ;Exit code
50 K ^TMP("PXRMEXDH",$J)
51 K ^TMP("PXRMEXHF",$J)
52 K ^TMP("PXRMEXFND",$J)
53 K ^TMP("PXRMEXIA",$J)
54 K ^TMP("PXRMEXIAD",$J)
55 K ^TMP("PXRMEXID",$J)
56 K ^TMP("PXRMEXIH",$J)
57 K ^TMP("PXRMEXLC",$J)
58 K ^TMP("PXRMEXLD",$J)
59 K ^TMP("PXRMEXLHF",$J)
60 K ^TMP("PXRMEXLMM",$J)
61 K ^TMP("PXRMEXLR",$J)
62 K ^TMP("PXRMEXMH",$J)
63 K ^TMP("PXRMEXMM",$J)
64 K ^TMP("PXRMEXRI",$J)
65 K ^TMP("PXRMEXTMP",$J)
66 K ^TMP("PXRMEXTXT",$J)
67 D CLEAN^VALM10
68 D FULL^VALM1
69 S VALMBCK="Q"
70 Q
71 ;
72 ;=====================================================
73HDR ; Header code
74 S VALMHDR(1)="Exchange File Entries."
75 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
76 Q
77 ;
78 ;=====================================================
79HELP ;Help code
80 ;The following variables have to be newed so that when we return
81 ;from the help display they will be defined.
82 N ORU,ORUPRMT,XQORM
83 D EN^VALM("PXRM EX MAIN HELP")
84 Q
85 ;
86 ;=====================================================
87INIT ;Init
88 S VALMCNT=0
89 Q
90 ;
91 ;=====================================================
92LDHF ;Load a host file into the repository.
93 N IND,FILE,PATH,RBL,SUCCESS,TEMP
94 ;Select the host file to load.
95 D CLEAR^VALM1
96 S TEMP=$$GETEHF^PXRMEXHF
97 I TEMP="" S VALMBCK="R" Q
98 S PATH=$P(TEMP,U,1)
99 S FILE=$P(TEMP,U,2)
100 D LHF^PXRMEXHF(.SUCCESS,PATH,FILE)
101 S RBL=SUCCESS
102 I SUCCESS D
103 . S VALMHDR(1)="Host file "_PATH_FILE_" successfully loaded."
104 E D
105 . S VALMHDR(1)="There were problems loading host file "_PATH_FILE_"."
106 . S TEMP=""
107 . S IND=""
108 . F S IND=$O(SUCCESS(IND)) Q:+IND=0 D
109 .. I SUCCESS(IND) S RBL=1 Q
110 .. I +$O(SUCCESS(IND))=0 S TEMP=TEMP_IND
111 .. E S TEMP=TEMP_IND_", "
112 . S VALMHDR(2)="Entries with problems were "_TEMP_"."
113 ;Rebuild the list for display.
114 D BLDLIST^PXRMEXLC(RBL)
115 S VALMBCK="R"
116 Q
117 ;
118 ;=====================================================
119LDMM ;Load a MailMan message into the repository.
120 N IND,RBL,TEMP,XMZ
121 ;Select the MailMan message to load.
122 D CLEAR^VALM1
123 S XMZ=$$GETMESSN^PXRMEXMM
124 I XMZ=-1 W !,"No packed reminder definitions selected/found!" H 2
125 I +XMZ'>0 S VALMBCK="R" Q
126 D LMM^PXRMEXMM(.SUCCESS,XMZ)
127 S RBL=SUCCESS
128 I SUCCESS D
129 . S VALMHDR(1)="MailMan message "_XMZ_" successfully loaded."
130 .;Rebuild the list for display.
131 . D BLDLIST^PXRMEXLC(1)
132 E D
133 . S VALMHDR(1)="There were problems loading MailMan message "_XMZ_"."
134 . S TEMP=""
135 . S IND=""
136 . F S IND=$O(SUCCESS(IND)) Q:+IND=0 D
137 .. I SUCCESS(IND) S RBL=1 Q
138 .. I +$O(SUCCESS(IND))=0 S TEMP=TEMP_IND
139 .. E S TEMP=TEMP_IND_", "
140 . S VALMHDR(2)="Entries with problems were "_TEMP_"."
141 ;Rebuild the list for display.
142 D BLDLIST^PXRMEXLC(RBL)
143 S VALMBCK="R"
144 Q
145 ;
146 ;=====================================================
147LRDEF ;List the name and print name of all reminder definitions.
148 N VALMCNT
149 I $D(^TMP("PXRMEXLD",$J,"VALMCNT")) S VALMCNT=^TMP("PXRMEXLD",$J,"VALMCNT")
150 E D
151 . N ARO,DEFLIST
152 . S ARO=$$QUERYAO^PXRMLIST
153 . S ^TMP("PXRMEXLD",$J,"ARO")=ARO
154 . D RDEF^PXRMLIST(.DEFLIST,ARO)
155 . M ^TMP("PXRMEXLD",$J)=DEFLIST
156 . S VALMCNT=DEFLIST("VALMCNT")
157 I '$G(^TMP("PXRMEXLD",$J,"ARO")) D CHGCAP^VALM("INACTIVE","Inactive")
158 D EN^VALM("PXRM EX REMINDER LIST")
159 Q
160 ;
161 ;=====================================================
162PEXIT ;PXRM EXCH MENU protocol exit code
163 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
164 ;Reset after page up/down etc
165 D XQORM
166 Q
167 ;
168 ;=====================================================
169START ;Main entry point for PXRM EXCHANGE
170 N PXRMDONE,PXRMNMCH
171 ;PXRMDONE is set to true if the user enters an action of Quit.
172 S PXRMDONE=0
173 ;PXRMNMCH is used to store name change information. If a finding
174 ;is copied to a new name or is replaced by another finding the
175 ;information is stored here. It is used when installing definitions
176 ;or dialogs so they use the new or replaced finding.
177 N VALMBCK,VALMSG,X,XMZ
178 S X="IORESET"
179 D ENDR^%ZISS
180 D EN^VALM("PXRM EX REMINDER EXCHANGE")
181 W IORESET
182 D KILL^%ZISS
183 Q
184 ;
185 ;=====================================================
186XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXCH SELECT ENTRY",0))_U_"1:"_VALMCNT
187 S XQORM("A")="Select Action: "
188 Q
189 ;
190 ;=====================================================
191XSEL ;PXRM EXCH SELECT COMPONENT validation
192 N SEL,PXRMRIEN
193 S SEL=$P(XQORNOD(0),"=",2)
194 ;Remove trailing ,
195 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
196 ;Invalid selection
197 I SEL["," D Q
198 .W $C(7),!,"Only one item number allowed." H 2
199 .S VALMBCK="R"
200 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("SEL",SEL))) D Q
201 .W $C(7),!,SEL_" is not a valid item number." H 2
202 .S VALMBCK="R"
203 ;
204 ;Get the repository ien.
205 S PXRMRIEN=^TMP("PXRMEXLR",$J,"SEL",SEL)
206 ;
207 ;Full screen mode
208 D FULL^VALM1
209 ;
210 ;Option to Install, Delete or Install History
211 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,OPTION,X,Y
212 S DIR(0)="SBM"_U_"IFE:Install Exchange File Entry;"
213 S DIR(0)=DIR(0)_"DFE:Delete Exchange File Entry;"
214 S DIR(0)=DIR(0)_"IH:Installation History;"
215 S DIR("A")="Select Action: "
216 S DIR("B")="IFE"
217 S DIR("?")="Select from the codes displayed. For detailed help type ??"
218 S DIR("??")=U_"D HLP^PXRMEXIX(3)"
219 D ^DIR
220 I $D(DIROUT)!$D(DIRUT) S VALMBCK="R" Q
221 I $D(DTOUT)!$D(DUOUT) S VALMBCK="R" Q
222 S OPTION=Y
223 ;
224 ;Install
225 I OPTION="IFE" D
226 .D EN^VALM("PXRM EX LIST COMPONENTS")
227 .K ^TMP("PXRMEXLC",$J)
228 ;
229 I OPTION="DFE" D
230 .N COUNT,DELLIST,IEN,IND,RELIST,VALMY
231 .S DELLIST(PXRMRIEN)=""
232 .D DELETE^PXRMEXU1(.DELLIST)
233 .;Rebuild the list for List Manager to display.
234 .K ^TMP("PXRMEXLR",$J)
235 .D REXL^PXRMLIST("PXRMEXLR")
236 .S VALMCNT=^TMP("PXRMEXLR",$J,"VALMCNT")
237 .S VALMHDR(1)="Deleted 1 exchange file entry",VALMHDR(2)=" ",VALMBCK="R"
238 ;
239 I OPTION="IH" D START^PXRMEXIH
240 ;
241 S VALMBCK="R"
242 Q
Note: See TracBrowser for help on using the repository browser.