PXRMP9E ; SLC/KER - Environoment Check for LEX*2.0*49/PXRM+2*9 ;02/22/2007
;;2.0;CLINICAL REMINDERS;**9**;Feb 04, 2005;Build 4
;
; Local Variables not NEWed or KILLed
; XPDENV
;
; Global Variables
; None
;
; External References
; DBIA 10015 EN^DIQ1
; DBIA 10141 $$PATCH^XPDUTL
; DBIA 10141 $$VERSION^XPDUTL
; DBIA 10141 BMES^XPDUTL
; DBIA 10141 MES^XPDUTL
;
ENV ; LEX*2.0*49 Environment Check
D BM(" Code Set Update message fix (Remedy Ticket 175985)"),M(" ")
N DA,DIC,DIQ,DR,PXRMB,PXRMBLD,PXRMBLDS,PXRMERR,PXRMHF,PXRMI,PXRML,PXRMPAT,PXRMPN,PXRMREQ,PXRMS,PXRMT,PXRMU,PXRMV,PXRMVER,X
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"
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"
K PXRMERR D:+($$UR)'>0 ET("User not defined (DUZ)") I $D(PXRMERR) D ABRT Q
D:+($$SY)'>0 ET("Undefined IO variable(s)") I $D(PXRMERR) D ABRT Q
I +($G(XPDENV))>0 D
. D M(" Fixes the following components:")
. D BM(" LEX*2.0*49 Protocol LEXICAL SERVICES UPDATE")
. D M(" Routines LEXXFI, LEXXFI7, LEXXGI, LEXXGI2, and LEXXST")
. D BM(" ICPT*6.0*34 Protocol ICPT CODE UPDATE EVENT")
. D M(" Routine ICPTAU")
. D BM(" ICD*18.0*28 Protocol ICD CODE UPDATE EVENT")
. D M(" Routine ICDUPDT")
. D BM(" PXRM*2.0*9 Protocol PXRM CODE SET UPDATE CPT")
. D M(" Protocol PXRM CODE SET UPDATE ICD")
. D M(" Routines PXRMCSD and PXRMCSTX"),M(" ")
D M(" Checking installed package version numbers")
S PXRMVER=$$VERSION^XPDUTL("LEX") I +PXRMVER'>1.9999 D D ABRT Q
. D ET(" Required Lexicon version 2.0 not found.")
S PXRMV=" Lexicon Utility v "_PXRMVER,PXRMV=PXRMV_$J(" ",(30-$L(PXRMV)))
S PXRMVER=$$VERSION^XPDUTL("PXRM") I +PXRMVER'>1.9999 D D ABRT Q
. D ET(" Required Clinical Reminders version 2.0 not found.")
S PXRMV=PXRMV_" Clinical Reminders v "_PXRMVER
D M(PXRMV) S PXRMV=""
S PXRMVER=$$VERSION^XPDUTL("ICD") I +PXRMVER'>17.9999 D D ABRT Q
. D ET(" Required ICD DRG Grouper version 18.0 not found.")
S PXRMV=" ICD DRG Grouper v "_PXRMVER,PXRMV=PXRMV_$J(" ",(30-$L(PXRMV)))
S PXRMVER=$$VERSION^XPDUTL("ICPT") I +PXRMVER'>5.9999 D D ABRT Q
. D ET(" Required ICPT/HCPCS Codes version 6.0 not found.")
S PXRMV=PXRMV_" ICPT/HCPCS Codes v "_PXRMVER
D M(PXRMV) S PXRMV="" K PXRMERR D BM(" Checking for required patches")
I $L(PXRMREQ) D
. N PXRMPAT,PXRMI,PXRMPN,PXRMV,PXRMT
. F PXRMI=1:1 Q:'$L($P(PXRMREQ,";",PXRMI)) S PXRMPAT=$P(PXRMREQ,";",PXRMI) D
. . S PXRMPN=$$PATCH^XPDUTL(PXRMPAT) S PXRMT=" "_PXRMPAT
. . S:PXRMPN>0 PXRMT=PXRMT_$J(" ",(35-$L(PXRMT)))_"installed"
. . D:PXRMPN>0 M(PXRMT) I +PXRMPN'>0 D ET((PXRMPAT_" not found, please install "_PXRMPAT_" before continuing"))
I $D(PXRMERR) D ABRT Q
QUIT ; Quit Passed Environment Check - OK
D OK
Q
ABRT ; Abort Failed Environment Check, KILL the distribution
S PXRMBLDS="LEX*2.0*49;ICD*18.0*28;ICPT*6.0*34;PXRM*2.0*9"
D:$D(PXRMERR) ED S XPDABORT=1,XPDQUIT=1 N PXRMI
F PXRMI=1:1 Q:'$L($P(PXRMBLDS,";",PXRMI)) S XPDQUIT($P(PXRMBLDS,";",PXRMI))=1
K PXRMERR
Q
CLR ; Clear Environment
K DA,DIC,DIQ,DR,PXRMB,PXRMBLD,PXRMBLDS,PXRMERR,PXRMHF,PXRMI,PXRML,PXRMPAT,PXRMPN,PXRMREQ,PXRMS,PXRMT,PXRMU,PXRMV,PXRMVER,X
Q
OK ; Environment is OK
N PXRMI,PXRMB,PXRMS,PXRML
S PXRMS=" Environment "_$S($L($G(PXRMHF)):("for distribution "_$G(PXRMHF)_" "),1:"")_"is ok"
D BM(PXRMS)
S PXRML=" This distribution contains builds: "
D M(" ") F PXRMI=1:1 Q:'$L($P($G(PXRMBLDS),";",PXRMI)) S PXRMB=$P($G(PXRMBLDS),";",PXRMI) D
. S PXRMS=PXRML_PXRMB,PXRML=" " D:$L($G(PXRMB)) M(PXRMS)
D M(" ")
Q
;
; Individual Checks
UR(X) ; Check User variables
Q:'$L($G(DUZ(0))) 0
Q:+($G(DUZ))=0!($$NOTDEF(+$G(DUZ))) 0
Q 1
NOTDEF(PXRMI) ; Check to see if user is defined
N DA,DR,DIQ,PXRMU,DIC S DA=PXRMI,DR=.01,DIC=200,DIQ="PXRMU" D EN^DIQ1
Q '$D(PXRMU)
SY(X) ; Check System variables
Q:'$D(IO)!('$D(IOF))!('$D(IOM))!('$D(ION))!('$D(IOSL))!('$D(IOST)) 0
Q 1
;
; Messages
ET(X) ; Error Test
N PXRMI S PXRMI=+($G(PXRMERR(0))),PXRMI=PXRMI+1,PXRMERR(PXRMI)=" "_$G(X),PXRMERR(0)=PXRMI
Q
ED ; Error Display
N PXRMI S PXRMI=0 F S PXRMI=$O(PXRMERR(PXRMI)) Q:+PXRMI=0 D M(PXRMERR(PXRMI))
D M(" ") K PXRMERR Q
BM(X) ; Blank Line with Message
D BMES^XPDUTL($G(X)) Q
M(X) ; Message
D MES^XPDUTL($G(X)) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMP9E 4741 printed Apr 09, 2024@20:51:20 Page 2
PXRMP9E ; SLC/KER - Environoment Check for LEX*2.0*49/PXRM+2*9 ;02/22/2007
+1 ;;2.0;CLINICAL REMINDERS;**9**;Feb 04, 2005;Build 4
+2 ;
+3 ; Local Variables not NEWed or KILLed
+4 ; XPDENV
+5 ;
+6 ; Global Variables
+7 ; None
+8 ;
+9 ; External References
+10 ; DBIA 10015 EN^DIQ1
+11 ; DBIA 10141 $$PATCH^XPDUTL
+12 ; DBIA 10141 $$VERSION^XPDUTL
+13 ; DBIA 10141 BMES^XPDUTL
+14 ; DBIA 10141 MES^XPDUTL
+15 ;
ENV ; LEX*2.0*49 Environment Check
+1 DO BM(" Code Set Update message fix (Remedy Ticket 175985)")
DO M(" ")
+2 NEW DA,DIC,DIQ,DR,PXRMB,PXRMBLD,PXRMBLDS,PXRMERR,PXRMHF,PXRMI,PXRML,PXRMPAT,PXRMPN,PXRMREQ,PXRMS,PXRMT,PXRMU,PXRMV,PXRMVER,X
+3 KILL XPDABORT,XPDQUIT
SET U="^"
SET 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"
+4 SET PXRMBLD="LEX*2.0*49"
SET PXRMBLDS="LEX*2.0*49;ICD*18.0*28;ICPT*6.0*34;PXRM*2.0*9"
SET PXRMHF="LEX_2_49.KID"
+5 KILL PXRMERR
if +($$UR)'>0
DO ET("User not defined (DUZ)")
IF $DATA(PXRMERR)
DO ABRT
QUIT
+6 if +($$SY)'>0
DO ET("Undefined IO variable(s)")
IF $DATA(PXRMERR)
DO ABRT
QUIT
+7 IF +($GET(XPDENV))>0
Begin DoDot:1
+8 DO M(" Fixes the following components:")
+9 DO BM(" LEX*2.0*49 Protocol LEXICAL SERVICES UPDATE")
+10 DO M(" Routines LEXXFI, LEXXFI7, LEXXGI, LEXXGI2, and LEXXST")
+11 DO BM(" ICPT*6.0*34 Protocol ICPT CODE UPDATE EVENT")
+12 DO M(" Routine ICPTAU")
+13 DO BM(" ICD*18.0*28 Protocol ICD CODE UPDATE EVENT")
+14 DO M(" Routine ICDUPDT")
+15 DO BM(" PXRM*2.0*9 Protocol PXRM CODE SET UPDATE CPT")
+16 DO M(" Protocol PXRM CODE SET UPDATE ICD")
+17 DO M(" Routines PXRMCSD and PXRMCSTX")
DO M(" ")
End DoDot:1
+18 DO M(" Checking installed package version numbers")
+19 SET PXRMVER=$$VERSION^XPDUTL("LEX")
IF +PXRMVER'>1.9999
Begin DoDot:1
+20 DO ET(" Required Lexicon version 2.0 not found.")
End DoDot:1
DO ABRT
QUIT
+21 SET PXRMV=" Lexicon Utility v "_PXRMVER
SET PXRMV=PXRMV_$JUSTIFY(" ",(30-$LENGTH(PXRMV)))
+22 SET PXRMVER=$$VERSION^XPDUTL("PXRM")
IF +PXRMVER'>1.9999
Begin DoDot:1
+23 DO ET(" Required Clinical Reminders version 2.0 not found.")
End DoDot:1
DO ABRT
QUIT
+24 SET PXRMV=PXRMV_" Clinical Reminders v "_PXRMVER
+25 DO M(PXRMV)
SET PXRMV=""
+26 SET PXRMVER=$$VERSION^XPDUTL("ICD")
IF +PXRMVER'>17.9999
Begin DoDot:1
+27 DO ET(" Required ICD DRG Grouper version 18.0 not found.")
End DoDot:1
DO ABRT
QUIT
+28 SET PXRMV=" ICD DRG Grouper v "_PXRMVER
SET PXRMV=PXRMV_$JUSTIFY(" ",(30-$LENGTH(PXRMV)))
+29 SET PXRMVER=$$VERSION^XPDUTL("ICPT")
IF +PXRMVER'>5.9999
Begin DoDot:1
+30 DO ET(" Required ICPT/HCPCS Codes version 6.0 not found.")
End DoDot:1
DO ABRT
QUIT
+31 SET PXRMV=PXRMV_" ICPT/HCPCS Codes v "_PXRMVER
+32 DO M(PXRMV)
SET PXRMV=""
KILL PXRMERR
DO BM(" Checking for required patches")
+33 IF $LENGTH(PXRMREQ)
Begin DoDot:1
+34 NEW PXRMPAT,PXRMI,PXRMPN,PXRMV,PXRMT
+35 FOR PXRMI=1:1
if '$LENGTH($PIECE(PXRMREQ,";",PXRMI))
QUIT
SET PXRMPAT=$PIECE(PXRMREQ,";",PXRMI)
Begin DoDot:2
+36 SET PXRMPN=$$PATCH^XPDUTL(PXRMPAT)
SET PXRMT=" "_PXRMPAT
+37 if PXRMPN>0
SET PXRMT=PXRMT_$JUSTIFY(" ",(35-$LENGTH(PXRMT)))_"installed"
+38 if PXRMPN>0
DO M(PXRMT)
IF +PXRMPN'>0
DO ET((PXRMPAT_" not found, please install "_PXRMPAT_" before continuing"))
End DoDot:2
End DoDot:1
+39 IF $DATA(PXRMERR)
DO ABRT
QUIT
QUIT ; Quit Passed Environment Check - OK
+1 DO OK
+2 QUIT
ABRT ; Abort Failed Environment Check, KILL the distribution
+1 SET PXRMBLDS="LEX*2.0*49;ICD*18.0*28;ICPT*6.0*34;PXRM*2.0*9"
+2 if $DATA(PXRMERR)
DO ED
SET XPDABORT=1
SET XPDQUIT=1
NEW PXRMI
+3 FOR PXRMI=1:1
if '$LENGTH($PIECE(PXRMBLDS,";",PXRMI))
QUIT
SET XPDQUIT($PIECE(PXRMBLDS,";",PXRMI))=1
+4 KILL PXRMERR
+5 QUIT
CLR ; Clear Environment
+1 KILL DA,DIC,DIQ,DR,PXRMB,PXRMBLD,PXRMBLDS,PXRMERR,PXRMHF,PXRMI,PXRML,PXRMPAT,PXRMPN,PXRMREQ,PXRMS,PXRMT,PXRMU,PXRMV,PXRMVER,X
+2 QUIT
OK ; Environment is OK
+1 NEW PXRMI,PXRMB,PXRMS,PXRML
+2 SET PXRMS=" Environment "_$SELECT($LENGTH($GET(PXRMHF)):("for distribution "_$GET(PXRMHF)_" "),1:"")_"is ok"
+3 DO BM(PXRMS)
+4 SET PXRML=" This distribution contains builds: "
+5 DO M(" ")
FOR PXRMI=1:1
if '$LENGTH($PIECE($GET(PXRMBLDS),";",PXRMI))
QUIT
SET PXRMB=$PIECE($GET(PXRMBLDS),";",PXRMI)
Begin DoDot:1
+6 SET PXRMS=PXRML_PXRMB
SET PXRML=" "
if $LENGTH($GET(PXRMB))
DO M(PXRMS)
End DoDot:1
+7 DO M(" ")
+8 QUIT
+9 ;
+10 ; Individual Checks
UR(X) ; Check User variables
+1 if '$LENGTH($GET(DUZ(0)))
QUIT 0
+2 if +($GET(DUZ))=0!($$NOTDEF(+$GET(DUZ)))
QUIT 0
+3 QUIT 1
NOTDEF(PXRMI) ; Check to see if user is defined
+1 NEW DA,DR,DIQ,PXRMU,DIC
SET DA=PXRMI
SET DR=.01
SET DIC=200
SET DIQ="PXRMU"
DO EN^DIQ1
+2 QUIT '$DATA(PXRMU)
SY(X) ; Check System variables
+1 if '$DATA(IO)!('$DATA(IOF))!('$DATA(IOM))!('$DATA(ION))!('$DATA(IOSL))!('$DATA(IOST))
QUIT 0
+2 QUIT 1
+3 ;
+4 ; Messages
ET(X) ; Error Test
+1 NEW PXRMI
SET PXRMI=+($GET(PXRMERR(0)))
SET PXRMI=PXRMI+1
SET PXRMERR(PXRMI)=" "_$GET(X)
SET PXRMERR(0)=PXRMI
+2 QUIT
ED ; Error Display
+1 NEW PXRMI
SET PXRMI=0
FOR
SET PXRMI=$ORDER(PXRMERR(PXRMI))
if +PXRMI=0
QUIT
DO M(PXRMERR(PXRMI))
+2 DO M(" ")
KILL PXRMERR
QUIT
BM(X) ; Blank Line with Message
+1 DO BMES^XPDUTL($GET(X))
QUIT
M(X) ; Message
+1 DO MES^XPDUTL($GET(X))
QUIT
