- BGP4P1 ; IHS/CMI/LAB - v11.0 patch 1 env routine 08 Dec 2010 3:10 PM ;
- ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
- ;
- ;
- ;SEND OUT BGP TAXONOMIES
- ; 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 '$INSTALLD("BGP*11.0*1") D SORRY(2)
- ;;I '$INSTALLD("BJPC*2.0*5") D SORRY(2)
- I +$$VERSION^XPDUTL("BGP")<11 D MES^XPDUTL($$CJ^XLFSTR("Version 11.0 of BGP is required. Not installed.",80)) D SORRY(2) I 1
- ;E D MES^XPDUTL($$CJ^XLFSTR("Requires BMX v4.0....Present.",80))
- Q
- ;
- PRE ;EP
- Q
- POST ;EP - called from kids build
- ;wipe out partial area files.
- S BGPX=0 F S BGPX=$O(^BGPGPDCJ(BGPX)) Q:BGPX'=+BGPX D
- .I '$D(^BGPGPDCJ(BGPX,1.1)) S DA=BGPX,DIK="^BGPGPDCJ(" D ^DIK S DA=BGPX,DIK="^BGPGPDPJ(" D ^DIK S DA=BGPX,DIK="^BGPGPDBJ(" D ^DIK
- Q
- INSTALLD(BGPSTAL) ;EP - Determine if patch BGPSTAL was installed, where
- ; BGPSTAL is the name of the INSTALL. E.g "AG*6.0*11".
- ;
- NEW BGPY,DIC,X,Y
- S X=$P(BGPSTAL,"*",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(BGPSTAL,"*",2)
- D ^DIC
- I Y<1 D IMES Q 0
- S DIC=DIC_+Y_",""PAH"",",X=$P(BGPSTAL,"*",3)
- D ^DIC
- S BGPY=Y
- D IMES
- Q $S(BGPY<1:0,1:1)
- IMES ;
- D MES^XPDUTL($$CJ^XLFSTR("Patch """_BGPSTAL_""" 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
- BGP4P1 ; IHS/CMI/LAB - v11.0 patch 1 env routine 08 Dec 2010 3:10 PM ;
- +1 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
- +2 ;
- +3 ;
- +4 ;SEND OUT BGP TAXONOMIES
- +5 ; The following line prevents the "Disable Options..." and "Move
- +6 ; Routines..." questions from being asked during the install.
- +7 IF $GET(XPDENV)=1
- SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
- +8 FOR X="XPO1","XPZ1","XPZ2","XPI1"
- SET XPDDIQ(X)=0
- +9 ;;I '$INSTALLD("BGP*11.0*1") D SORRY(2)
- +10 ;;I '$INSTALLD("BJPC*2.0*5") D SORRY(2)
- +11 IF +$$VERSION^XPDUTL("BGP")<11
- DO MES^XPDUTL($$CJ^XLFSTR("Version 11.0 of BGP is required. Not installed.",80))
- DO SORRY(2)
- IF 1
- +12 ;E D MES^XPDUTL($$CJ^XLFSTR("Requires BMX v4.0....Present.",80))
- +13 QUIT
- +14 ;
- PRE ;EP
- +1 QUIT
- POST ;EP - called from kids build
- +1 ;wipe out partial area files.
- +2 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPGPDCJ(BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:1
- +3 IF '$DATA(^BGPGPDCJ(BGPX,1.1))
- SET DA=BGPX
- SET DIK="^BGPGPDCJ("
- DO ^DIK
- SET DA=BGPX
- SET DIK="^BGPGPDPJ("
- DO ^DIK
- SET DA=BGPX
- SET DIK="^BGPGPDBJ("
- DO ^DIK
- End DoDot:1
- +4 QUIT
- INSTALLD(BGPSTAL) ;EP - Determine if patch BGPSTAL was installed, where
- +1 ; BGPSTAL is the name of the INSTALL. E.g "AG*6.0*11".
- +2 ;
- +3 NEW BGPY,DIC,X,Y
- +4 SET X=$PIECE(BGPSTAL,"*",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(BGPSTAL,"*",2)
- +9 DO ^DIC
- +10 IF Y<1
- DO IMES
- QUIT 0
- +11 SET DIC=DIC_+Y_",""PAH"","
- SET X=$PIECE(BGPSTAL,"*",3)
- +12 DO ^DIC
- +13 SET BGPY=Y
- +14 DO IMES
- +15 QUIT $SELECT(BGPY<1:0,1:1)
- IMES ;
- +1 DO MES^XPDUTL($$CJ^XLFSTR("Patch """_BGPSTAL_""" 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
