source: IHS-VA_UTILITIES-XB/XBEHRCK.m@ 641

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

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.
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.