PXRMP9E.m

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"

 S PXRMBLD="PXRM*2.0*9",PXRMBLDS="PXRM*2.0*9",PXRMHF="PXRM_2_9.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="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

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"

 +4        SET PXRMBLD="PXRM*2.0*9"

           SET PXRMBLDS="PXRM*2.0*9"

           SET PXRMHF="PXRM_2_9.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="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