BGP6P1.m

BGP6P1 ; IHS/CMI/LAB - v11.0 patch 1 env routine 08 Dec 2010 3:10 PM ;

 ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170

 ;

 ;

 ;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(^BGPGPDCM(BGPX)) Q:BGPX'=+BGPX  D

 .I '$D(^BGPGPDCM(BGPX,1.1)) S DA=BGPX,DIK="^BGPGPDCM(" D ^DIK S DA=BGPX,DIK="^BGPGPDPM(" D ^DIK S DA=BGPX,DIK="^BGPGPDBM(" 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

BGP6P1    ; IHS/CMI/LAB - v11.0 patch 1 env routine 08 Dec 2010 3:10 PM ;

 +1       ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170

 +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(^BGPGPDCM(BGPX))

               IF BGPX'=+BGPX

                   QUIT 

               Begin DoDot:1

 +3                IF '$DATA(^BGPGPDCM(BGPX,1.1))

                       SET DA=BGPX

                       SET DIK="^BGPGPDCM("

                       DO ^DIK

                       SET DA=BGPX

                       SET DIK="^BGPGPDPM("

                       DO ^DIK

                       SET DA=BGPX

                       SET DIK="^BGPGPDBM("

                       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