BSDP12PS.m

BSDP12PS ;cmi/anch/maw - PIMS Patch 1012 Post Init 2/27/2007 10:32:52 AM

 ;;5.3;PIMS;**1012**;FEB 27,2007;

 ;

 ;

 ;

 ;

EN ;EP - Post Init Entry Point

 D ADDPRT

 Q

 ;

ENV ;--environment check

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

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

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

 I '$$INSTALLD("PIMS*5.3*1011") D SORRY(2) Q

 Q

 ;

ADDPRT ;-- add an entry to the protocol file

 N PROT,PROTA

 S PROT=$O(^ORD(101,"B","BSDAM MENU",0))

 S PROTA=$O(^ORD(101,"B","BSDAM FOLLOW UP APPT",0))

 Q:'PROT

 Q:'PROTA

 N FDA,FIENS,FERR

 S FIENS="?+2,"_PROT_","

 S FDA(101.01,FIENS,.01)=PROTA

 S FDA(101.01,FIENS,2)="FU"

 S FDA(101.01,FIENS,3)=37

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

 I $D(FERR(1)) W !,"Error adding BSD FOLLOW UP APPT to the Item Multiple of Protocol BSDAM MENU"

 Q

 ;

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

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

 ;

 NEW BSDY,DIC,X,Y

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

 D ^DIC

 I Y<1 D IMES Q 0

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

 D ^DIC

 S BSDY=Y

 D IMES

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

IMES ;

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

 ;

BSDP12PS  ;cmi/anch/maw - PIMS Patch 1012 Post Init 2/27/2007 10:32:52 AM

 +1       ;;5.3;PIMS;**1012**;FEB 27,2007;

 +2       ;

 +3       ;

 +4       ;

 +5       ;

EN        ;EP - Post Init Entry Point

 +1        DO ADDPRT

 +2        QUIT 

 +3       ;

ENV       ;--environment check

 +1        IF $GET(XPDENV)=1

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

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

               SET XPDDIQ(X)=0

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

               DO SORRY(2)

               QUIT 

 +4        IF '$$INSTALLD("PIMS*5.3*1011")

               DO SORRY(2)

               QUIT 

 +5        QUIT 

 +6       ;

ADDPRT    ;-- add an entry to the protocol file

 +1        NEW PROT,PROTA

 +2        SET PROT=$ORDER(^ORD(101,"B","BSDAM MENU",0))

 +3        SET PROTA=$ORDER(^ORD(101,"B","BSDAM FOLLOW UP APPT",0))

 +4        IF 'PROT

               QUIT 

 +5        IF 'PROTA

               QUIT 

 +6        NEW FDA,FIENS,FERR

 +7        SET FIENS="?+2,"_PROT_","

 +8        SET FDA(101.01,FIENS,.01)=PROTA

 +9        SET FDA(101.01,FIENS,2)="FU"

 +10       SET FDA(101.01,FIENS,3)=37

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

 +12       IF $DATA(FERR(1))

               WRITE !,"Error adding BSD FOLLOW UP APPT to the Item Multiple of Protocol BSDAM MENU"

 +13       QUIT 

 +14      ;

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

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

 +2       ;

 +3        NEW BSDY,DIC,X,Y

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

 +9        DO ^DIC

 +10       IF Y<1

               DO IMES

               QUIT 0

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

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

 +12       DO ^DIC

 +13       SET BSDY=Y

 +14       DO IMES

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

IMES      ;

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

 +6       ;