source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXLM.m@ 1150

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

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