BUD9ENV.m

BUD9ENV ; IHS/CMI/LAB - environmental check 13 Jan 2009 7:22 AM ;

 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50

 ;

ENV ;

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

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

 I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0

 F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0

 I $$VERSION^XPDUTL("BJPC")'="2.0" D SORRY(2)

 I $$VERSION^XPDUTL("BGP")'="9.0" D SORRY(2)

 I '$D(^DIC(9.4,"C","LEX")) D MES^XPDUTL($$CJ^XLFSTR("Lexicon is *NOT* installed.",IOM)) D SORRY(2)

 Q

 ;

 ;

PRE ;

 F DA=1:1:50 S DIK="^BUDCNTL(" D ^DIK

 F DA=1:1:50 S DIK="^BUDIL(" D ^DIK

 F DA=1:1:50 S DIK="^BUDTFIVE(" D ^DIK

 F DA=1:1:50 S DIK="^BUDTTA(" D ^DIK

 F DA=1:1:50 S DIK="^BUDFCNTL(" D ^DIK

 F DA=1:1:50 S DIK="^BUDFIL(" D ^DIK

 F DA=1:1:50 S DIK="^BUDFFIV(" D ^DIK

 F DA=1:1:50 S DIK="^BUDFTTA(" D ^DIK

 F DA=1:1:50 S DIK="^BUDVCNTL(" D ^DIK

 F DA=1:1:50 S DIK="^BUDVIL(" D ^DIK

 F DA=1:1:50 S DIK="^BUDVTFIV(" D ^DIK

 F DA=1:1:50 S DIK="^BUDVTTA(" D ^DIK

 F DA=1:1:50 S DIK="^BUDSCNTL(" D ^DIK

 F DA=1:1:50 S DIK="^BUDSIL(" D ^DIK

 F DA=1:1:50 S DIK="^BUDSTFIV(" D ^DIK

 F DA=1:1:50 S DIK="^BUDSTTA(" D ^DIK

 F DA=1:1:50 S DIK="^BUDECNTL(" D ^DIK

 F DA=1:1:50 S DIK="^BUDEIL(" D ^DIK

 F DA=1:1:50 S DIK="^BUDETFIV(" D ^DIK

 F DA=1:1:50 S DIK="^BUDETTA(" D ^DIK

 F DA=1:1:50 S DIK="^BUDGCNTL(" D ^DIK

 F DA=1:1:50 S DIK="^BUDGIL(" D ^DIK

 F DA=1:1:50 S DIK="^BUDGTFIV(" D ^DIK

 F DA=1:1:50 S DIK="^BUDGTTA(" D ^DIK

 F DA=1:1:50 S DIK="^BUDNCNTL(" D ^DIK

 F DA=1:1:50 S DIK="^BUDNIL(" D ^DIK

 F DA=1:1:50 S DIK="^BUDNTFIV(" D ^DIK

 F DA=1:1:50 S DIK="^BUDNTTA(" D ^DIK

 Q

POST ;

 ;move site parameters from 04 to 05 on first time install only

 I '$O(^BUDNSITE(0)) D

 .S BUDX=0 F  S BUDX=$O(^BUDESITE(BUDX)) Q:BUDX'=+BUDX   D

 ..M ^BUDNSITE(BUDX)=^BUDESITE(BUDX)

 ..S DA=BUDX,DIK="^BUDNSITE(" D IX1^DIK

 D ^BUD9TX

 ;create and populate drug taxonomy

 D DRUG

 Q

INSTALLD(BUDSTAL) ;EP - Determine if patch BUDSTAL was installed, where

 ; BUDSTAL is the name of the INSTALL.  E.g "AG*6.0*11".

 ;

 NEW BUDY,DIC,X,Y

 S X=$P(BUDSTAL,"*",1)

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

 D IX^DIC

 I Y<1 D IMES Q 0

 S DIC=DIC_+Y_",22,",X=$P(BUDSTAL,"*",2)

 D ^DIC

 I Y<1 D IMES Q 0

 S DIC=DIC_+Y_",""PAH"",",X=$P(BUDSTAL,"*",3)

 D ^DIC

 S BUDY=Y

 D IMES

 Q $S(BUDY<1:0,1:1)

IMES ;

 D MES^XPDUTL($$CJ^XLFSTR("Patch """_BUDSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))

 Q

SORRY(X) ;

 KILL DIFQ

 I X=3 S XPDQUIT=2 Q

 S XPDQUIT=X

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

 Q

DRUG ;

 S ATXFLG=1

 S BUDX="BUD DIABETES MEDS TAX" D DRUG1

 K ATXFLG,BUDX,BUDDA,BUDTX

 Q

DRUG1 ;

 W !,"Creating ",BUDX," Taxonomy..."

 S BUDTX=$O(^ATXAX("B",BUDX,0))

 I 'BUDTX D  Q:Y=-1

 .S X=BUDX,DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I

 .I Y=-1 W !!,"ERROR IN CREATING ",BUDX," TAX" Q

 .S BUDTX=+Y,$P(^ATXAX(BUDTX,0),U,2)=BUDX,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=173,$P(^(0),U,13)=0,$P(^(0),U,15)=50,^ATXAX(BUDTX,21,0)="^9002226.02101A^0^0"

 S DA=BUDTX,DIK="^ATXAX(" D IX1^DIK

 I $O(^BUDNCNTL(6,11,0)) D

 .S A=0,B="" F  S A=$O(^ATXAX(BUDTX,21,A)) Q:A'=+A  S B=A

 .S BUDC=B

 .S ^ATXAX(BUDTX,21,0)="^9002226.02101A^"_B_U_B

 .S J=0 F  S J=$O(^PSDRUG(J)) Q:J'=+J  S C=$P($G(^PSDRUG(J,2)),U,4) I C]"",$D(^BUDNCNTL(6,11,"B",C)) D

 ..Q:$D(^ATXAX(BUDTX,21,"B",J))

 ..S BUDC=BUDC+1,^ATXAX(BUDTX,21,BUDC,0)=J_U_J

 S DA=BUDTX,DIK="^ATXAX(" D IX1^DIK

 Q

BUD9ENV   ; IHS/CMI/LAB - environmental check 13 Jan 2009 7:22 AM ;

 +1       ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50

 +2       ;

ENV       ;

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

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

 +3        IF $GET(XPDENV)=1

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

 +4        FOR X="XPO1","XPZ1","XPZ2","XPI1"

               SET XPDDIQ(X)=0

 +5        IF $$VERSION^XPDUTL("BJPC")'="2.0"

               DO SORRY(2)

 +6        IF $$VERSION^XPDUTL("BGP")'="9.0"

               DO SORRY(2)

 +7        IF '$DATA(^DIC(9.4,"C","LEX"))

               DO MES^XPDUTL($$CJ^XLFSTR("Lexicon is *NOT* installed.",IOM))

               DO SORRY(2)

 +8        QUIT 

 +9       ;

 +10      ;

PRE       ;

 +1        FOR DA=1:1:50

               SET DIK="^BUDCNTL("

               DO ^DIK

 +2        FOR DA=1:1:50

               SET DIK="^BUDIL("

               DO ^DIK

 +3        FOR DA=1:1:50

               SET DIK="^BUDTFIVE("

               DO ^DIK

 +4        FOR DA=1:1:50

               SET DIK="^BUDTTA("

               DO ^DIK

 +5        FOR DA=1:1:50

               SET DIK="^BUDFCNTL("

               DO ^DIK

 +6        FOR DA=1:1:50

               SET DIK="^BUDFIL("

               DO ^DIK

 +7        FOR DA=1:1:50

               SET DIK="^BUDFFIV("

               DO ^DIK

 +8        FOR DA=1:1:50

               SET DIK="^BUDFTTA("

               DO ^DIK

 +9        FOR DA=1:1:50

               SET DIK="^BUDVCNTL("

               DO ^DIK

 +10       FOR DA=1:1:50

               SET DIK="^BUDVIL("

               DO ^DIK

 +11       FOR DA=1:1:50

               SET DIK="^BUDVTFIV("

               DO ^DIK

 +12       FOR DA=1:1:50

               SET DIK="^BUDVTTA("

               DO ^DIK

 +13       FOR DA=1:1:50

               SET DIK="^BUDSCNTL("

               DO ^DIK

 +14       FOR DA=1:1:50

               SET DIK="^BUDSIL("

               DO ^DIK

 +15       FOR DA=1:1:50

               SET DIK="^BUDSTFIV("

               DO ^DIK

 +16       FOR DA=1:1:50

               SET DIK="^BUDSTTA("

               DO ^DIK

 +17       FOR DA=1:1:50

               SET DIK="^BUDECNTL("

               DO ^DIK

 +18       FOR DA=1:1:50

               SET DIK="^BUDEIL("

               DO ^DIK

 +19       FOR DA=1:1:50

               SET DIK="^BUDETFIV("

               DO ^DIK

 +20       FOR DA=1:1:50

               SET DIK="^BUDETTA("

               DO ^DIK

 +21       FOR DA=1:1:50

               SET DIK="^BUDGCNTL("

               DO ^DIK

 +22       FOR DA=1:1:50

               SET DIK="^BUDGIL("

               DO ^DIK

 +23       FOR DA=1:1:50

               SET DIK="^BUDGTFIV("

               DO ^DIK

 +24       FOR DA=1:1:50

               SET DIK="^BUDGTTA("

               DO ^DIK

 +25       FOR DA=1:1:50

               SET DIK="^BUDNCNTL("

               DO ^DIK

 +26       FOR DA=1:1:50

               SET DIK="^BUDNIL("

               DO ^DIK

 +27       FOR DA=1:1:50

               SET DIK="^BUDNTFIV("

               DO ^DIK

 +28       FOR DA=1:1:50

               SET DIK="^BUDNTTA("

               DO ^DIK

 +29       QUIT 

POST      ;

 +1       ;move site parameters from 04 to 05 on first time install only

 +2        IF '$ORDER(^BUDNSITE(0))

               Begin DoDot:1

 +3                SET BUDX=0

                   FOR 

                       SET BUDX=$ORDER(^BUDESITE(BUDX))

                       IF BUDX'=+BUDX

                           QUIT 

                       Begin DoDot:2

 +4                        MERGE ^BUDNSITE(BUDX)=^BUDESITE(BUDX)

 +5                        SET DA=BUDX

                           SET DIK="^BUDNSITE("

                           DO IX1^DIK

                       End DoDot:2

               End DoDot:1

 +6        DO ^BUD9TX

 +7       ;create and populate drug taxonomy

 +8        DO DRUG

 +9        QUIT 

INSTALLD(BUDSTAL) ;EP - Determine if patch BUDSTAL was installed, where

 +1       ; BUDSTAL is the name of the INSTALL.  E.g "AG*6.0*11".

 +2       ;

 +3        NEW BUDY,DIC,X,Y

 +4        SET X=$PIECE(BUDSTAL,"*",1)

 +5        SET DIC="^DIC(9.4,"

           SET DIC(0)="FM"

           SET D="C"

 +6        DO IX^DIC

 +7        IF Y<1

               DO IMES

               QUIT 0

 +8        SET DIC=DIC_+Y_",22,"

           SET X=$PIECE(BUDSTAL,"*",2)

 +9        DO ^DIC

 +10       IF Y<1

               DO IMES

               QUIT 0

 +11       SET DIC=DIC_+Y_",""PAH"","

           SET X=$PIECE(BUDSTAL,"*",3)

 +12       DO ^DIC

 +13       SET BUDY=Y

 +14       DO IMES

 +15       QUIT $SELECT(BUDY<1:0,1:1)

IMES      ;

 +1        DO MES^XPDUTL($$CJ^XLFSTR("Patch """_BUDSTAL_""" is"_$SELECT(Y<1:" *NOT*",1:"")_" installed.",IOM))

 +2        QUIT 

SORRY(X)  ;

 +1        KILL DIFQ

 +2        IF X=3

               SET XPDQUIT=2

               QUIT 

 +3        SET XPDQUIT=X

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

 +5        QUIT 

DRUG      ;

 +1        SET ATXFLG=1

 +2        SET BUDX="BUD DIABETES MEDS TAX"

           DO DRUG1

 +3        KILL ATXFLG,BUDX,BUDDA,BUDTX

 +4        QUIT 

DRUG1     ;

 +1        WRITE !,"Creating ",BUDX," Taxonomy..."

 +2        SET BUDTX=$ORDER(^ATXAX("B",BUDX,0))

 +3        IF 'BUDTX

               Begin DoDot:1

 +4                SET X=BUDX

                   SET DIC="^ATXAX("

                   SET DIC(0)="L"

                   SET DIADD=1

                   SET DLAYGO=9002226

                   DO ^DIC

                   KILL DIC,DA,DIADD,DLAYGO,I

 +5                IF Y=-1

                       WRITE !!,"ERROR IN CREATING ",BUDX," TAX"

                       QUIT 

 +6                SET BUDTX=+Y

                   SET $PIECE(^ATXAX(BUDTX,0),U,2)=BUDX

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

                   SET $PIECE(^(0),U,9)=DT

                   SET $PIECE(^(0),U,12)=173

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

                   SET $PIECE(^(0),U,15)=50

                   SET ^ATXAX(BUDTX,21,0)="^9002226.02101A^0^0"

               End DoDot:1

               IF Y=-1

                   QUIT 

 +7        SET DA=BUDTX

           SET DIK="^ATXAX("

           DO IX1^DIK

 +8        IF $ORDER(^BUDNCNTL(6,11,0))

               Begin DoDot:1

 +9                SET A=0

                   SET B=""

                   FOR 

                       SET A=$ORDER(^ATXAX(BUDTX,21,A))

                       IF A'=+A

                           QUIT 

                       SET B=A

 +10               SET BUDC=B

 +11               SET ^ATXAX(BUDTX,21,0)="^9002226.02101A^"_B_U_B

 +12               SET J=0

                   FOR 

                       SET J=$ORDER(^PSDRUG(J))

                       IF J'=+J

                           QUIT 

                       SET C=$PIECE($GET(^PSDRUG(J,2)),U,4)

                       IF C]""

                           IF $DATA(^BUDNCNTL(6,11,"B",C))

                               Begin DoDot:2

 +13                               IF $DATA(^ATXAX(BUDTX,21,"B",J))

                                       QUIT 

 +14                               SET BUDC=BUDC+1

                                   SET ^ATXAX(BUDTX,21,BUDC,0)=J_U_J

                               End DoDot:2

               End DoDot:1

 +15       SET DA=BUDTX

           SET DIK="^ATXAX("

           DO IX1^DIK

 +16       QUIT