source: IHS-VA_UTILITIES-XB/trunk/XBEHRCK.m@ 850

Last change on this file since 850 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.
File size: 7.5 KB
Line 
1XBEHRCK ;IHS/SET/GTH - EHR ENVIRONMENT CHECK ; [ 05/11/2004 ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; To add to the list of requirements, add the info specific to the
5 ; application after the "ENV" label, below in the form:
6 ; Namespace*Version*Patch
7 ; E.g., to check for Pt Reg, v 6.1, patch 2:
8 ; AG*6.1*2
9 ; If the application has no patches, leave the patch info blank.
10 ; 20040512d
11 ; 20040603 IHS/SET/HMW Added checks for Pharmacy Data Management
12 ; 20040615 Changed ABSP to check for patch 10 instead of 8
13 ; 20040708 Removed SD patch 63
14 ; 20040719 Removed SD Patches 300 307 314
15 ; Removed HL Patches 17 18 21 8 9
16 ; Removed GMTS Patch 45
17 ; Removed ABSP Patch 10
18 ; Removed APSE 6.1
19 ;
20ENV ; Namespace*Version*Patch
21 ;;XU*8.0*1010
22 ;;XU*8.0*2
23 ;;XU*8.0*15
24 ;;XU*8.0*16
25 ;;XU*8.0*26
26 ;;XU*8.0*28
27 ;;XU*8.0*32
28 ;;XU*8.0*44
29 ;;XU*8.0*311
30 ;;XU*8.0*288
31 ;;XT*7.3*1002
32 ;;XT*7.3*73
33 ;;DI*22.0*1001
34 ;;DI*22.0*70
35 ;;HL*1.6*1005
36 ;;PSO*6.0*5
37 ;;APSA*6.1
38 ;;AUPN*99.1*11
39 ;;LEX*2*9
40 ;;VSIT*2
41 ;;PX*1*45
42 ;;PX*1*73
43 ;;PX*1*74
44 ;;PX*1*88
45 ;;PX*1*115
46 ;;PXRM*1.5*1
47 ;;PXRM*1.5*2
48 ;;PXRM*1.5*3
49 ;;PXRM*1.5*4
50 ;;PXRM*1.5*5
51 ;;PXRM*1.5*6
52 ;;PXRM*1.5*7
53 ;;PXRM*1.5*8
54 ;;PXRM*1.5*9
55 ;;PXRM*1.5*10
56 ;;PXRM*1.5*11
57 ;;PXRM*1.5*13
58 ;;PXRM*1.5*14
59 ;;PXRM*1.5*17
60 ;;PXRM*1.5*15
61 ;;PXRM*1.5*19
62 ;;GMTS*2.7*36
63 ;;GMTS*2.7*43
64 ;;GMTS*2.7*52
65 ;;GMTS*2.7*60
66 ;;GMTS*2.7*62
67 ;;GMTS*2.7*64
68 ;;GMTS*2.7*68
69 ;;PIMS*5.3T11
70 ;;DG*5.3*124
71 ;;DG*5.3*57
72 ;;DG*5.3*134
73 ;;DG*5.3*249
74 ;;DG*5.3*265
75 ;;DG*5.3*276
76 ;;DG*5.3*277
77 ;;DG*5.3*389
78 ;;DG*5.3*415
79 ;;SD*5.3*131 SEQ #127
80 ;;SD*5.3*263 SEQ #243
81 ;;SD*5.3*254 SEQ #247
82 ;;USR*1.0
83 ;;TIU*1.0*1 SEQ #4
84 ;;TIU*1.0*3 SEQ #5
85 ;;TIU*1.0*4 SEQ #8
86 ;;TIU*1.0*7 SEQ #9
87 ;;TIU*1.0*15 SEQ #10
88 ;;TIU*1.0*19 SEQ #19
89 ;;TIU*1.0*28 SEQ #22
90 ;;TIU*1.0*31 SEQ #34
91 ;;TIU*1.0*47 SEQ #60
92 ;;TIU*1.0*76 SEQ #70
93 ;;TIU*1.0*80 SEQ #82
94 ;;TIU*1.0*102 SEQ #86
95 ;;TIU*1.0*89 SEQ #90
96 ;;TIU*1.0*108 SEQ #99
97 ;;TIU*1.0*170
98 ;;TIU*1.0*150 SEQ #142
99 ;;TIU*1.0*100 SEQ #103
100 ;;TIU*1.0*105 SEQ #106
101 ;;TIU*1.0*119 SEQ #109
102 ;;TIU*1.0*125 SEQ #113
103 ;;TIU*1.0*127 SEQ #118
104 ;;TIU*1.0*122 SEQ #119
105 ;;TIU*1.0*124 SEQ #124
106 ;;TIU*1.0*138 SEQ #125
107 ;;TIU*1.0*63 SEQ #76
108 ;;TIU*1.0*137
109 ;;TIU*1.0*134
110 ;;TIU*1.0*109 SEQ #123
111 ;;LR*5.2*1018
112 ;;LR*5.2*128
113 ;;LR*5.2*121
114 ;;LR*5.2*201
115 ;;LR*5.2*191
116 ;;LR*5.2*208
117 ;;RA*5.0
118 ;;PSJ*4.5
119 ;;BW*2.0
120 ;;BW*2.0*9
121 ;;XWB*1.1*6
122 ;;XWB*1.1*12
123 ;;END; <-- Leave this alone. It's the LOOP ender.
124 ; -----------------------------------------------------
125 ;
126 ; begin - FOR TEST ONLY REMOVE FOR DIST.
127 ;I '$G(DUZ) D
128 ;. KILL
129 ;. KILL ^XUTL("XQ",$J)
130 ;. D HOME^%ZIS,DT^DICRW,^XBKTMP
131 ;. S DUZ=1,DUZ(2)=$P(^AUTTSITE(1,0),U)
132 ;.Q
133 ; end - FOR TEST ONLY REMOVE FOR DIST.
134 ;
135 I '$G(DUZ) D RSLT(""),RSLT("Please set your DUZ before running this routine.") Q
136 D DT^DICRW,^XBKVAR
137 D ASKDEV Q:POP
138 Q:$D(ZTQUEUED)
139 ;
140ZTM ;EP - Taskman entry point
141 KILL ^TMP("XBEHRCK",$J)
142 NEW XBEH,XBEHNEED,XBEHOK
143 N XBEHNS,XBEHNAME,XBEHVER,XBEHPKG,XBEHC
144 U IO
145 S XBEHOK=1,XBEHC=0
146 S XBEHPKG=""
147 S X=$P(^VA(200,DUZ,0),U)
148 ;
149 D RSLT(""),RSLT("Hello, "_$P(X,",",2)_" "_$P(X,","))
150 D RSLT(""),RSLT("Environment Checker for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_", as of "_$P($T(+2),";",6)_".")
151 ;
152 F XBEH=1:1 Q:$P($T(ENV+XBEH),";",3)="END" D
153 . S XBEH(0)=$P($T(ENV+XBEH),";",3)
154 . S XBEHNS=$P(XBEH(0),"*")
155 . Q:XBEHNS=""
156 . S XBEHVER=$P(XBEH(0),"*",2)
157 . S XBEHNAME=$O(^DIC(9.4,"C",XBEHNS,0))
158 . S:XBEHNAME]"" XBEHNAME=$G(^DIC(9.4,XBEHNAME,0))
159 . S:XBEHNAME]"" XBEHNAME=$P(XBEHNAME,U)
160 . D VCHK(XBEHNS,XBEHVER,XBEHNAME)
161 . D RSLT("")
162 . Q
163 ;
164 D RXCK
165 D RSLT(""),RSLT("ENVIRONMENT "_$S(XBEHOK:"",1:"-NOT- ")_"OK.")
166 I 'XBEHOK D
167 . D RSLT("INSTALL THE FOLLOWING PACKAGES AND PATCHES:")
168 . S XBEHNEED=""
169 . F S XBEHNEED=$O(XBEHNEED(XBEHNEED)) Q:'$L(XBEHNEED) D RSLT(XBEHNEED)
170 .Q
171 ;
172 D POST
173 ;
174 Q
175RXCK ;
176 ;
177 N PS S PS=$P($G(^PS(59.7,1,80)),U,2)
178 I 'PS D
179 . S XBEHMSG="The Pharmacy Data Management package must be installed, and the Orderable Item Auto Create run to completion."
180 . D RSLT(XBEHMSG)
181 . S XBEHNEED("Pharmacy Data Management")=""
182 I PS=1 D
183 . S XBEHMSG="The Orderable Item Auto Create in Pharmacy Data Management package must be run to completion."
184 . D RSLT(XBEHMSG)
185 . S XBEHNEED("Pharmacy Data Management Orderable Item Auto Create")=""
186 I PS=2 D
187 . S XBEHMSG="The Manual Matching Process for Orderable Items in Pharmacy Data Management package has not been completed."
188 . D RSLT(XBEHMSG)
189 . S XBEHNEED("Pharmacy Data Management Manual Matching Process must be completed.")=""
190 I $P($G(^PS(59.7,1,80)),"^",3)'=3 D
191 . S XBEHMSG="Pharmacy Dosage Conversion is not complete."
192 . D RSLT(XBEHMSG)
193 . S XBEHNEED("Pharmacy Dosage Conversion must be completed.")=""
194 Q
195 ;
196VCHK(XBEHPRE,XBEHVER,XBEHNAME) ; -----------------------------------------------------
197 ; Check versions needed.
198 ; Modifies XBEHNEED
199 ;
200 NEW XBEHV,XBEHMSG
201 I XBEHNAME'=XBEHPKG D
202 . D RSLT("")
203 . S XBEHPKG=XBEHNAME
204 . S XBEHV=$$VERSION^XPDUTL(XBEHPRE)
205 . S XBEHMSG=XBEHNAME_$S(XBEHNAME]"":":",1:"")_" Need at least "_XBEHPRE_" v "_XBEHVER
206 . I +XBEHV S XBEHMSG=XBEHMSG_"....."_XBEHPRE_" v "_XBEHV_" is installed."
207 . E S XBEHMSG=XBEHMSG_"....."_XBEHPRE_" is not installed."
208 . D RSLT(XBEHMSG)
209 . I XBEHV<XBEHVER D Q
210 . . S XBEHOK=0,XBEHMSG=""
211 . . S XBEHMSG=$S(+XBEHV:"Upgrade ",1:"Install ")
212 . . S XBEHMSG=" "_XBEHMSG_XBEHPRE_" v "_XBEHVER_"."
213 . . D RSLT(XBEHMSG)
214 . . S XBEHNEED(XBEH(0))=""
215 . .Q
216 Q:'$P(XBEH(0),"*",3)
217 D PCHK(XBEH(0))
218 Q
219 ;
220PCHK(XBEH) ; -----------------------------------------------------
221 ; Determine if patch XBEH was installed, where XBEH is
222 ; the name of the INSTALL. E.g "AVA*93.2*12".
223 ;
224 D RSLT(" Need Patch '"_XBEH)
225 NEW DIC,X,Y
226 ; lookup package.
227 S X=$P(XBEH,"*",1)
228 S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
229 D IX^DIC
230 I Y<1 D Q
231 . D RSLT(" Failed lookup for Namespace '"_X_"' in PACKAGE file.")
232 . S XBEHOK=0,XBEHNEED(XBEH)=""
233 . D DUPCHK(X)
234 .Q
235 ; lookup version.
236 S DIC=DIC_+Y_",22,",X=$P(XBEH,"*",2)
237 D ^DIC
238 I Y<1 D RSLT(" Failed lookup for version '"_X_"' in PACKAGE file.") S XBEHOK=0,XBEHNEED(XBEH)="" Q
239 ; lookup patch.
240 S DIC=DIC_+Y_",""PAH"",",X=$P(XBEH,"*",3)
241 D ^DIC
242 I Y<1 D RSLT(" Failed lookup for patch '"_X_"' in PACKAGE file.") S XBEHOK=0,XBEHNEED(XBEH)="" Q
243 D RSLT(" Patch '"_XBEH_"' IS installed.")
244 Q
245DUPCHK(X) ; -----------------------------------------------------
246 ; Check PACKAGE file for duplicate entries of namespace X.
247 ;
248 NEW DA,DIC
249 S DIC="^DIC(9.4,",DIC(0)="",D="C"
250 D IX^DIC
251 Q:Y>0
252 Q:'$D(^DIC(9.4,"C",X))
253 D RSLT(" You Have More Than One Entry In The")
254 D RSLT(" PACKAGE File with an "_X_" prefix.")
255 D RSLT(" One entry needs to be deleted.")
256 Q
257POST ; -----------------------------------------------------
258 NEW XMSUB,XMDUZ,XMTEXT,XMY
259 S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$G(DUZ,.5),XMTEXT="^TMP(""XBEHRCK"",$J,",XMY(1)="",XMY(DUZ)=""
260 D SINGLE("XUPROGMODE")
261 NEW DIFROM
262 D ^XMD
263 KILL ^TMP("XBEHRCK",$J)
264 D RSLT("")
265 D RSLT("The results are in your MailMan 'IN' basket.")
266 Q
267 ; -----------------------------------------------------
268SINGLE(K) ; Get holders of a single key K.
269 NEW Y
270 S Y=0
271 Q:'$D(^XUSEC(K))
272 F S Y=$O(^XUSEC(K,Y)) Q:'Y S XMY(Y)=""
273 Q
274 ; -----------------------------------------------------
275RSLT(%) ;S ^(0)=$G(^TMP("XBEHRCK",$J,0))+1,^(^(0))=%
276 ;More readable:
277 S ^TMP("XBEHRCK",$J,0)=$G(^TMP("XBEHRCK",$J,0))+1
278 S ^TMP("XBEHRCK",$J,^TMP("XBEHRCK",$J,0))=%
279 W !,%
280 Q
281 ;
282ASKDEV ;EP
283 K IOP
284 S %ZIS="NQ" D ^%ZIS Q:POP
285 S IOP=ION
286 S %ZIS("IOPAR")=IOPAR
287 I $D(IO("Q")) D QUE I '$D(ZTQUEUED) K IOP G ASKDEV
288 I $D(IO("Q")) D HOME^%ZIS W !,"REPORT IS QUEUED!"
289 Q
290 ;
291QUE ;
292 S ZTRTN="ZTM^XBEHRCK",ZTDESC="EHR ENVIRONMENT CHECK"
293 S ZTSAVE("IOP")=""
294 D ^%ZTLOAD
295 Q
Note: See TracBrowser for help on using the repository browser.