APCS2P4.m

APCS2P4 ; IHS/CMI/LAB - environment check ;

 ;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009

 ;

 ;

 ; 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" W !,"version 2.0 of BJPC is required" D SORRY(2)

 I '$$INSTALLD("BJPC*2.0*3") D SORRY(2)

 ;

 Q

 ;

PRE ;

 Q

POST ;

LAB ;EP

 S APCSX="SURVEILLANCE RAPID FLU TESTS" D LAB1

 D HLO

 Q

LAB1 ;

 S APCSDA=$O(^ATXLAB("B",APCSX,0))

 Q:APCSDA  ;taxonomy already exisits

 W !,"Creating ",APCSX," Taxonomy..."

 S X=APCSX,DIC="^ATXLAB(",DIC(0)="L",DIADD=1,DLAYGO=9002228 D ^DIC K DIC,DA,DIADD,DLAYGO,I

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

 S APCSTX=+Y,$P(^ATXLAB(APCSTX,0),U,2)=APCSX,$P(^(0),U,5)=DUZ,$P(^(0),U,6)=DT,$P(^(0),U,8)="B",$P(^(0),U,9)=60

 S ^ATXLAB(APCSTX,21,0)="^9002228.02101PA^0^0"

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

 Q

 ;

HLO ;--register the app in HLO

 N FDA,FIENS,FERR,PCCI

 Q:$O(^HLD(779.2,"B","RPMS-ILI",0))

 S PCCI=$O(^DIC(9.4,"B","IHS PCC SUITE",0))

 Q:'PCCI

 S FIENS=""

 S FDA(779.2,"+1,",.01)="RPMS-ILI"

 S FDA(779.2,"+1,",2)=PCCI

 D UPDATE^DIE("","FDA","FIENS","FERR(1)")

 Q

 ;

OPTIONS ;

 ;

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

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

 ;

 NEW APCLY,DIC,X,Y

 S X=$P(APCLSTAL,"*",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(APCLSTAL,"*",2)

 D ^DIC

 I Y<1 D IMES Q 0

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

 D ^DIC

 S APCLY=Y

 D IMES

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

IMES ;

 D MES^XPDUTL($$CJ^XLFSTR("Patch """_APCLSTAL_""" 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

APCS2P4   ; IHS/CMI/LAB - environment check ;

 +1       ;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009

 +2       ;

 +3       ;

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

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

 +6        IF $GET(XPDENV)=1

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

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

               SET XPDDIQ(X)=0

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

               WRITE !,"version 2.0 of BJPC is required"

               DO SORRY(2)

 +9        IF '$$INSTALLD("BJPC*2.0*3")

               DO SORRY(2)

 +10      ;

 +11       QUIT 

 +12      ;

PRE       ;

 +1        QUIT 

POST      ;

LAB       ;EP

 +1        SET APCSX="SURVEILLANCE RAPID FLU TESTS"

           DO LAB1

 +2        DO HLO

 +3        QUIT 

LAB1      ;

 +1        SET APCSDA=$ORDER(^ATXLAB("B",APCSX,0))

 +2       ;taxonomy already exisits

           IF APCSDA

               QUIT 

 +3        WRITE !,"Creating ",APCSX," Taxonomy..."

 +4        SET X=APCSX

           SET DIC="^ATXLAB("

           SET DIC(0)="L"

           SET DIADD=1

           SET DLAYGO=9002228

           DO ^DIC

           KILL DIC,DA,DIADD,DLAYGO,I

 +5        IF Y=-1

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

               QUIT 

 +6        SET APCSTX=+Y

           SET $PIECE(^ATXLAB(APCSTX,0),U,2)=APCSX

           SET $PIECE(^(0),U,5)=DUZ

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

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

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

 +7        SET ^ATXLAB(APCSTX,21,0)="^9002228.02101PA^0^0"

 +8        SET DA=APCSTX

           SET DIK="^ATXAX("

           DO IX1^DIK

 +9        QUIT 

 +10      ;

HLO       ;--register the app in HLO

 +1        NEW FDA,FIENS,FERR,PCCI

 +2        IF $ORDER(^HLD(779.2,"B","RPMS-ILI",0))

               QUIT 

 +3        SET PCCI=$ORDER(^DIC(9.4,"B","IHS PCC SUITE",0))

 +4        IF 'PCCI

               QUIT 

 +5        SET FIENS=""

 +6        SET FDA(779.2,"+1,",.01)="RPMS-ILI"

 +7        SET FDA(779.2,"+1,",2)=PCCI

 +8        DO UPDATE^DIE("","FDA","FIENS","FERR(1)")

 +9        QUIT 

 +10      ;

OPTIONS   ;

 +1       ;

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

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

 +2       ;

 +3        NEW APCLY,DIC,X,Y

 +4        SET X=$PIECE(APCLSTAL,"*",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(APCLSTAL,"*",2)

 +9        DO ^DIC

 +10       IF Y<1

               DO IMES

               QUIT 0

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

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

 +12       DO ^DIC

 +13       SET APCLY=Y

 +14       DO IMES

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

IMES      ;

 +1        DO MES^XPDUTL($$CJ^XLFSTR("Patch """_APCLSTAL_""" 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