| 1 | PXRMP9E ; 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 | ;
|
|---|
| 17 | ENV ; 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;LEX*2.0*32;LEX*2.0*46;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
|
|---|
| 57 | QUIT ; Quit Passed Environment Check - OK
|
|---|
| 58 | D OK
|
|---|
| 59 | Q
|
|---|
| 60 | ABRT ; 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
|
|---|
| 66 | CLR ; 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
|
|---|
| 69 | OK ; 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
|
|---|
| 80 | UR(X) ; Check User variables
|
|---|
| 81 | Q:'$L($G(DUZ(0))) 0
|
|---|
| 82 | Q:+($G(DUZ))=0!($$NOTDEF(+$G(DUZ))) 0
|
|---|
| 83 | Q 1
|
|---|
| 84 | NOTDEF(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)
|
|---|
| 87 | SY(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
|
|---|
| 92 | ET(X) ; Error Test
|
|---|
| 93 | N PXRMI S PXRMI=+($G(PXRMERR(0))),PXRMI=PXRMI+1,PXRMERR(PXRMI)=" "_$G(X),PXRMERR(0)=PXRMI
|
|---|
| 94 | Q
|
|---|
| 95 | ED ; 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
|
|---|
| 98 | BM(X) ; Blank Line with Message
|
|---|
| 99 | D BMES^XPDUTL($G(X)) Q
|
|---|
| 100 | M(X) ; Message
|
|---|
| 101 | D MES^XPDUTL($G(X)) Q
|
|---|
