Routine: AUMI10

AUMI10 ;IHS/OIT/NKD - ENVIRONMENT CHECK/PRE/POST-INSTALL FOR ICD10 - 09/04/2018 ;

 ;;19.0;ICD UPDATE;;SEP 04,2018;Build 1

 I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q

 I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q

 S X=$P(^VA(200,DUZ,0),U)

 W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)

 W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_$S($L($P($T(+2),";",5))>4:" Patch "_$P($T(+2),";",5),1:"")_".",IOM),!

 S:'$$VCHK("AICD","4.0") XPDQUIT=2

 S:'$$VCHK("AUM","18.0") XPDQUIT=2

 NEW DA,DIC

 S X="AUM",DIC="^DIC(9.4,",DIC(0)="",D="C"

 D IX^DIC

 I Y<0,$D(^DIC(9.4,"C","AUM")) D

 . W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AUM"" prefix.",IOM)

 . W !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)

 . D SORRY(2)

.Q

 I $G(XPDQUIT) W !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7 Q

 W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)

 I $G(XPDENV)=1 D

 . ; The following line prevents the "Disable Options..." and "Move

 . ; Routines..." questions from being asked during the install.

 . S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0

.Q

 I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2)

SORRY(X) ;

 KILL DIFQ

 S XPDQUIT=X

 W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)

VCHK(AUMPRE,AUMVER,AUMPAT) ; Check patch level

 N AUMV,AUMP

 S AUMV=$$VERSION^XPDUTL(AUMPRE)

 I (AUMV<AUMVER) K DIFQ D DISP(AUMPRE,AUMVER,$G(AUMPAT),AUMV,$G(AUMP),0) Q 0

 I '$D(AUMPAT) D DISP(AUMPRE,AUMVER,$G(AUMPAT),AUMV,$G(AUMP),1) Q 1

 S AUMP=+$$LAST(AUMPRE,AUMVER)

 I (AUMP<AUMPAT) K DIFQ D DISP(AUMPRE,AUMVER,$G(AUMPAT),AUMVER,$G(AUMP),0) Q 0

 D DISP(AUMPRE,AUMVER,$G(AUMPAT),AUMVER,$G(AUMP),1)

Q 1

GCHK(AUMGL,AUMMSG) ; Check for global

 Q:'$L($G(AUMGL)) 0

 N AUMS

 S AUMS="Requires "_$S('$L($G(AUMMSG)):AUMGL,1:$G(AUMMSG))_"....."

 S AUMS=AUMS_$S($D(@AUMGL):"Present",1:"Not found ***FIX IT***")

 W !,$$CJ^XLFSTR(AUMS,IOM)

 Q $S($D(@AUMGL):1,1:0)

PCHK(PKG,VER,PAT) ; Check specific patch

 N PKGIEN,VERIEN,PATIEN,AUMS

 S PKG=$G(PKG),VER=$G(VER),PAT=$G(PAT)

 S AUMS="Requires "_PKG_" v"_VER_" p"_PAT_"....."

 . S PKGIEN=+$O(^DIC(9.4,"C",PKG,"")) Q:'PKGIEN

 . S VERIEN=+$O(^DIC(9.4,PKGIEN,22,"B",VER,"")) Q:'VERIEN

 . S PATIEN=+$O(^DIC(9.4,PKGIEN,22,VERIEN,"PAH","B",PAT,""))

 S AUMS=AUMS_$S(+$G(PATIEN):"Present",1:"Not found ***FIX IT***")

 W !,$$CJ^XLFSTR(AUMS,IOM)

 Q $S(+$G(PATIEN):1,1:0)

DISP(AUMPRE,AUMVER,AUMPAT,AUMV,AUMP,AUMR) ; Display requirement checking results

 N AUMS

 S AUMS="Need at least "_$G(AUMPRE)_" v"_$G(AUMVER)_$S($G(AUMPAT)]"":" p"_$G(AUMPAT),1:"")_"....."

 S AUMS=AUMS_$G(AUMPRE)_" v"_$G(AUMV)_$S($G(AUMP)]"":" p"_$G(AUMP),1:"")_" Present"

 S AUMS=AUMS_$S('AUMR:" ***FIX IT***",1:"")

 W !,$$CJ^XLFSTR(AUMS,IOM)

LAST(PKG,VER) ; EP - returns last patch applied for a Package, PATCH^DATE

 ;        Patch includes Seq # if Released

 N PKGIEN,VERIEN,LATEST,PATCH,SUBIEN

 I $G(VER)="" S VER=$$VERSION^XPDUTL(PKG) Q:'VER -1

 S PKGIEN=$O(^DIC(9.4,"C",PKG,"")) Q:'PKGIEN -1

 S VERIEN=$O(^DIC(9.4,PKGIEN,22,"B",VER,"")) Q:'VERIEN -1

 S LATEST=-1,PATCH=-1,SUBIEN=0

 F  S SUBIEN=$O(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN)) Q:SUBIEN'>0  D

 . I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST S LATEST=$P(^(0),U,2),PATCH=$P(^(0),U)

 . I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)=LATEST,$P(^(0),U)>PATCH S PATCH=$P(^(0),U)

 Q PATCH_U_LATEST

PRE ; EP FR KIDS

 N AUMI

 S AUMI=0 F  S AUMI=$O(^AUMDATA(AUMI)) Q:'AUMI  K ^AUMDATA(AUMI)

 F AUMI=3,4 S $P(^AUMDATA(0),"^",AUMI)=0

POST ; EP FR KIDS

 K ^TMP("AUM",$J)

 S ^TMP("AUM",$J,"AUMDT")="3"_(+$P($G(XPDNM)," ",2)-1)_"1001"

 D POST^AUMI10D

 K ^TMP("AUM",$J)

AUMI10    ;IHS/OIT/NKD - ENVIRONMENT CHECK/PRE/POST-INSTALL FOR ICD10 - 09/04/2018 ;

 +1       ;;19.0;ICD UPDATE;;SEP 04,2018;Build 1

 +2       ;

 +3        IF '$GET(DUZ)

               WRITE !,"DUZ UNDEFINED OR 0."

               DO SORRY(2)

               QUIT

 +4       ;

 +5        IF '$LENGTH($GET(DUZ(0)))

               WRITE !,"DUZ(0) UNDEFINED OR NULL."

               DO SORRY(2)

               QUIT

 +6       ;

 +7        SET X=$PIECE(^VA(200,DUZ,0),U)

 +8        WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)

 +9        WRITE !!,$$CJ^XLFSTR("Checking Environment for "_$PIECE($TEXT(+2),";",4)_" V "_$PIECE($TEXT(+2),";",3)_$SELECT($LENGTH($PIECE($TEXT(+2),";",5))>4:" Patch "_$PIECE($TEXT(+2),";",5),1:"")_".",IOM),!

 +10      ;

 +11       IF '$$VCHK("AICD","4.0")

               SET XPDQUIT=2

 +12       IF '$$VCHK("AUM","18.0")

               SET XPDQUIT=2

 +13      ;

 +14       NEW DA,DIC

 +15       SET X="AUM"

           SET DIC="^DIC(9.4,"

           SET DIC(0)=""

           SET D="C"

 +16       DO IX^DIC

 +17       IF Y<0

               IF $DATA(^DIC(9.4,"C","AUM"))

                   Begin DoDot:1

 +18                   WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AUM"" prefix.",IOM)

 +19                   WRITE !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)

 +20                   DO SORRY(2)

 +21                   QUIT

                   End DoDot:1

 +22      ;

 +23       IF $GET(XPDQUIT)

               WRITE !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7

               QUIT

 +24      ;

 +25       WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)

 +26      ;

 +27       IF $GET(XPDENV)=1

               Begin DoDot:1

 +28      ; The following line prevents the "Disable Options..." and "Move

 +29      ; Routines..." questions from being asked during the install.

 +30               SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0

 +31               QUIT

               End DoDot:1

 +32      ;

 +33       IF '$$DIR^XBDIR("E","","","","","",1)

               DO SORRY(2)

 +34       QUIT

 +35      ;

SORRY(X)  ;

 +1        KILL DIFQ

 +2        SET XPDQUIT=X

 +3        WRITE *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)

 +4        QUIT

 +5       ;

VCHK(AUMPRE,AUMVER,AUMPAT) ; Check patch level

 +1        NEW AUMV,AUMP

 +2        SET AUMV=$$VERSION^XPDUTL(AUMPRE)

 +3        IF (AUMV<AUMVER)

               KILL DIFQ

               DO DISP(AUMPRE,AUMVER,$GET(AUMPAT),AUMV,$GET(AUMP),0)

               QUIT 0

 +4        IF '$DATA(AUMPAT)

               DO DISP(AUMPRE,AUMVER,$GET(AUMPAT),AUMV,$GET(AUMP),1)

               QUIT 1

 +5        SET AUMP=+$$LAST(AUMPRE,AUMVER)

 +6        IF (AUMP<AUMPAT)

               KILL DIFQ

               DO DISP(AUMPRE,AUMVER,$GET(AUMPAT),AUMVER,$GET(AUMP),0)

               QUIT 0

 +7        DO DISP(AUMPRE,AUMVER,$GET(AUMPAT),AUMVER,$GET(AUMP),1)

 +8        QUIT 1

 +9       ;

GCHK(AUMGL,AUMMSG) ; Check for global

 +1        IF '$LENGTH($GET(AUMGL))

               QUIT 0

 +2        NEW AUMS

 +3        SET AUMS="Requires "_$SELECT('$LENGTH($GET(AUMMSG)):AUMGL,1:$GET(AUMMSG))_"....."

 +4        SET AUMS=AUMS_$SELECT($DATA(@AUMGL):"Present",1:"Not found ***FIX IT***")

 +5        WRITE !,$$CJ^XLFSTR(AUMS,IOM)

 +6        QUIT $SELECT($DATA(@AUMGL):1,1:0)

 +7       ;

PCHK(PKG,VER,PAT) ; Check specific patch

 +1        NEW PKGIEN,VERIEN,PATIEN,AUMS

 +2        SET PKG=$GET(PKG)

           SET VER=$GET(VER)

           SET PAT=$GET(PAT)

 +3        SET AUMS="Requires "_PKG_" v"_VER_" p"_PAT_"....."

 +4        Begin DoDot:1

 +5            SET PKGIEN=+$ORDER(^DIC(9.4,"C",PKG,""))

               IF 'PKGIEN

                   QUIT

 +6            SET VERIEN=+$ORDER(^DIC(9.4,PKGIEN,22,"B",VER,""))

               IF 'VERIEN

                   QUIT

 +7            SET PATIEN=+$ORDER(^DIC(9.4,PKGIEN,22,VERIEN,"PAH","B",PAT,""))

           End DoDot:1

 +8        SET AUMS=AUMS_$SELECT(+$GET(PATIEN):"Present",1:"Not found ***FIX IT***")

 +9        WRITE !,$$CJ^XLFSTR(AUMS,IOM)

 +10       QUIT $SELECT(+$GET(PATIEN):1,1:0)

 +11      ;

DISP(AUMPRE,AUMVER,AUMPAT,AUMV,AUMP,AUMR) ; Display requirement checking results

 +1       ;

 +2        NEW AUMS

 +3        SET AUMS="Need at least "_$GET(AUMPRE)_" v"_$GET(AUMVER)_$SELECT($GET(AUMPAT)]"":" p"_$GET(AUMPAT),1:"")_"....."

 +4        SET AUMS=AUMS_$GET(AUMPRE)_" v"_$GET(AUMV)_$SELECT($GET(AUMP)]"":" p"_$GET(AUMP),1:"")_" Present"

 +5        SET AUMS=AUMS_$SELECT('AUMR:" ***FIX IT***",1:"")

 +6        WRITE !,$$CJ^XLFSTR(AUMS,IOM)

 +7        QUIT

LAST(PKG,VER) ; EP - returns last patch applied for a Package, PATCH^DATE

 +1       ;        Patch includes Seq # if Released

 +2        NEW PKGIEN,VERIEN,LATEST,PATCH,SUBIEN

 +3        IF $GET(VER)=""

               SET VER=$$VERSION^XPDUTL(PKG)

               IF 'VER

                   QUIT -1

 +4        SET PKGIEN=$ORDER(^DIC(9.4,"C",PKG,""))

           IF 'PKGIEN

               QUIT -1

 +5        SET VERIEN=$ORDER(^DIC(9.4,PKGIEN,22,"B",VER,""))

           IF 'VERIEN

               QUIT -1

 +6        SET LATEST=-1

           SET PATCH=-1

           SET SUBIEN=0

 +7        FOR

               SET SUBIEN=$ORDER(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN))

               IF SUBIEN'>0

                   QUIT

               Begin DoDot:1

 +8                IF $PIECE(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST

                       SET LATEST=$PIECE(^(0),U,2)

                       SET PATCH=$PIECE(^(0),U)

 +9                IF $PIECE(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)=LATEST

                       IF $PIECE(^(0),U)>PATCH

                           SET PATCH=$PIECE(^(0),U)

               End DoDot:1

 +10       QUIT PATCH_U_LATEST

 +11      ;

PRE       ; EP FR KIDS

 +1        NEW AUMI

 +2        SET AUMI=0

FOR

               SET AUMI=$ORDER(^AUMDATA(AUMI))

               IF 'AUMI

                   QUIT

               KILL ^AUMDATA(AUMI)

 +3        FOR AUMI=3,4

               SET $PIECE(^AUMDATA(0),"^",AUMI)=0

 +4        QUIT

 +5       ;

POST      ; EP FR KIDS

 +1        KILL ^TMP("AUM",$JOB)

 +2        SET ^TMP("AUM",$JOB,"AUMDT")="3"_(+$PIECE($GET(XPDNM)," ",2)-1)_"1001"

 +3        DO POST^AUMI10D

 +4        KILL ^TMP("AUM",$JOB)

 +5        QUIT

 +6       ;

AUMI10.m