source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMP9E.m@ 1006

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1PXRMP9E ; SLC/KER - Environoment Check for LEX*2.0*49/PXRM+2*9 ;02/22/2007
2 ;;2.0;CLINICAL REMINDERS;**9**;Feb 04, 2005;Build 4
3 ;
4 ; Local Variables not NEWed or KILLed
5 ; XPDENV
6 ;
7 ; Global Variables
8 ; None
9 ;
10 ; External References
11 ; DBIA 10015 EN^DIQ1
12 ; DBIA 10141 $$PATCH^XPDUTL
13 ; DBIA 10141 $$VERSION^XPDUTL
14 ; DBIA 10141 BMES^XPDUTL
15 ; DBIA 10141 MES^XPDUTL
16 ;
17ENV ; LEX*2.0*49 Environment Check
18 D BM(" Code Set Update message fix (Remedy Ticket 175985)"),M(" ")
19 N DA,DIC,DIQ,DR,PXRMB,PXRMBLD,PXRMBLDS,PXRMERR,PXRMHF,PXRMI,PXRML,PXRMPAT,PXRMPN,PXRMREQ,PXRMS,PXRMT,PXRMU,PXRMV,PXRMVER,X
20 K XPDABORT,XPDQUIT S U="^",PXRMREQ="LEX*2.0*25;LEX*2.0*27;ICD*18.0*11;ICPT*6.0*16;PXRM*2.0*4"
21 S PXRMBLD="LEX*2.0*49",PXRMBLDS="LEX*2.0*49;ICD*18.0*28;ICPT*6.0*34;PXRM*2.0*9",PXRMHF="LEX_2_49.KID"
22 K PXRMERR D:+($$UR)'>0 ET("User not defined (DUZ)") I $D(PXRMERR) D ABRT Q
23 D:+($$SY)'>0 ET("Undefined IO variable(s)") I $D(PXRMERR) D ABRT Q
24 I +($G(XPDENV))>0 D
25 . D M(" Fixes the following components:")
26 . D BM(" LEX*2.0*49 Protocol LEXICAL SERVICES UPDATE")
27 . D M(" Routines LEXXFI, LEXXFI7, LEXXGI, LEXXGI2, and LEXXST")
28 . D BM(" ICPT*6.0*34 Protocol ICPT CODE UPDATE EVENT")
29 . D M(" Routine ICPTAU")
30 . D BM(" ICD*18.0*28 Protocol ICD CODE UPDATE EVENT")
31 . D M(" Routine ICDUPDT")
32 . D BM(" PXRM*2.0*9 Protocol PXRM CODE SET UPDATE CPT")
33 . D M(" Protocol PXRM CODE SET UPDATE ICD")
34 . D M(" Routines PXRMCSD and PXRMCSTX"),M(" ")
35 D M(" Checking installed package version numbers")
36 S PXRMVER=$$VERSION^XPDUTL("LEX") I +PXRMVER'>1.9999 D D ABRT Q
37 . D ET(" Required Lexicon version 2.0 not found.")
38 S PXRMV=" Lexicon Utility v "_PXRMVER,PXRMV=PXRMV_$J(" ",(30-$L(PXRMV)))
39 S PXRMVER=$$VERSION^XPDUTL("PXRM") I +PXRMVER'>1.9999 D D ABRT Q
40 . D ET(" Required Clinical Reminders version 2.0 not found.")
41 S PXRMV=PXRMV_" Clinical Reminders v "_PXRMVER
42 D M(PXRMV) S PXRMV=""
43 S PXRMVER=$$VERSION^XPDUTL("ICD") I +PXRMVER'>17.9999 D D ABRT Q
44 . D ET(" Required ICD DRG Grouper version 18.0 not found.")
45 S PXRMV=" ICD DRG Grouper v "_PXRMVER,PXRMV=PXRMV_$J(" ",(30-$L(PXRMV)))
46 S PXRMVER=$$VERSION^XPDUTL("ICPT") I +PXRMVER'>5.9999 D D ABRT Q
47 . D ET(" Required ICPT/HCPCS Codes version 6.0 not found.")
48 S PXRMV=PXRMV_" ICPT/HCPCS Codes v "_PXRMVER
49 D M(PXRMV) S PXRMV="" K PXRMERR D BM(" Checking for required patches")
50 I $L(PXRMREQ) D
51 . N PXRMPAT,PXRMI,PXRMPN,PXRMV,PXRMT
52 . F PXRMI=1:1 Q:'$L($P(PXRMREQ,";",PXRMI)) S PXRMPAT=$P(PXRMREQ,";",PXRMI) D
53 . . S PXRMPN=$$PATCH^XPDUTL(PXRMPAT) S PXRMT=" "_PXRMPAT
54 . . S:PXRMPN>0 PXRMT=PXRMT_$J(" ",(35-$L(PXRMT)))_"installed"
55 . . D:PXRMPN>0 M(PXRMT) I +PXRMPN'>0 D ET((PXRMPAT_" not found, please install "_PXRMPAT_" before continuing"))
56 I $D(PXRMERR) D ABRT Q
57QUIT ; Quit Passed Environment Check - OK
58 D OK
59 Q
60ABRT ; Abort Failed Environment Check, KILL the distribution
61 S PXRMBLDS="LEX*2.0*49;ICD*18.0*28;ICPT*6.0*34;PXRM*2.0*9"
62 D:$D(PXRMERR) ED S XPDABORT=1,XPDQUIT=1 N PXRMI
63 F PXRMI=1:1 Q:'$L($P(PXRMBLDS,";",PXRMI)) S XPDQUIT($P(PXRMBLDS,";",PXRMI))=1
64 K PXRMERR
65 Q
66CLR ; Clear Environment
67 K DA,DIC,DIQ,DR,PXRMB,PXRMBLD,PXRMBLDS,PXRMERR,PXRMHF,PXRMI,PXRML,PXRMPAT,PXRMPN,PXRMREQ,PXRMS,PXRMT,PXRMU,PXRMV,PXRMVER,X
68 Q
69OK ; Environment is OK
70 N PXRMI,PXRMB,PXRMS,PXRML
71 S PXRMS=" Environment "_$S($L($G(PXRMHF)):("for distribution "_$G(PXRMHF)_" "),1:"")_"is ok"
72 D BM(PXRMS)
73 S PXRML=" This distribution contains builds: "
74 D M(" ") F PXRMI=1:1 Q:'$L($P($G(PXRMBLDS),";",PXRMI)) S PXRMB=$P($G(PXRMBLDS),";",PXRMI) D
75 . S PXRMS=PXRML_PXRMB,PXRML=" " D:$L($G(PXRMB)) M(PXRMS)
76 D M(" ")
77 Q
78 ;
79 ; Individual Checks
80UR(X) ; Check User variables
81 Q:'$L($G(DUZ(0))) 0
82 Q:+($G(DUZ))=0!($$NOTDEF(+$G(DUZ))) 0
83 Q 1
84NOTDEF(PXRMI) ; Check to see if user is defined
85 N DA,DR,DIQ,PXRMU,DIC S DA=PXRMI,DR=.01,DIC=200,DIQ="PXRMU" D EN^DIQ1
86 Q '$D(PXRMU)
87SY(X) ; Check System variables
88 Q:'$D(IO)!('$D(IOF))!('$D(IOM))!('$D(ION))!('$D(IOSL))!('$D(IOST)) 0
89 Q 1
90 ;
91 ; Messages
92ET(X) ; Error Test
93 N PXRMI S PXRMI=+($G(PXRMERR(0))),PXRMI=PXRMI+1,PXRMERR(PXRMI)=" "_$G(X),PXRMERR(0)=PXRMI
94 Q
95ED ; Error Display
96 N PXRMI S PXRMI=0 F S PXRMI=$O(PXRMERR(PXRMI)) Q:+PXRMI=0 D M(PXRMERR(PXRMI))
97 D M(" ") K PXRMERR Q
98BM(X) ; Blank Line with Message
99 D BMES^XPDUTL($G(X)) Q
100M(X) ; Message
101 D MES^XPDUTL($G(X)) Q
Note: See TracBrowser for help on using the repository browser.