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
