BMCPRE.m

BMCPRE ; IHS/PHXAO/TMJ - PREINIT, CHK RQMNTS, ETC., DELETE DICS ;   

 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 ;

 ;Patch #1 - Includes running this same Pre-Init Routine

 NEW BMCNAME

 I '$G(DUZ) K DIFQ W $C(7),!,"DUZ UNDEFINED OR 0." S XPDQUIT=1 Q

 S IOM=IO ;IOM Variable doesn't appear to be around

 I '$L($G(DUZ(0))) K DIFQ W $C(7),!,"DUZ(0) UNDEFINED OR NULL." S XPDQUIT=1 Q

 S X=$P(^VA(200,DUZ,0),U),BMCNAME=$P($T(BMCPRE+1),";",4)

 W !!,"Hello - Checking system requirements...."

 I $G(^DD("VERSION"))<21 K DIFQ W $C(7),!,"I NEED AT LEAST FILEMAN 21." S XPDQUIT=1 Q

 W !,"FileMan OK.."

 I $S('$O(^DIC(9.4,"C","XU",0)):1,$G(^DIC(9.4,$O(^DIC(9.4,"C","XU",0)),"VERSION"))<7.1:1,1:0) K DIFQ W !,"I NEED AT LEAST KERNEL 7.1" S XPDQUIT=1 Q

 W !,"Kernel OK..."

 S %="STATUS"

 S X="BMC",Y="BMB"

 I '$D(^DIC(9.4,"C","BMC")),'$D(^DIC(19,"C",X)),'($E($O(^DIC(19,"B",Y)),1,4)=X),'($E($O(^DIC(19.1,"B",Y)),1,4)=X) W !!,"NEW INSTALL",! S ^TMP($J,"BMC","NEW INSTALL")=1 Q

 ;

 NEW DIC

V1 ;

 W !!,"Checking PACKAGE File For Duplicate "_BMCNAME_" Entries"

 S X="BMC",DIC="^DIC(9.4,",DIC(0)="",D="C" D IX^DIC

 I Y<0 D  S XPDQUIT=1 Q

 .K DIFQ

 .W !!,$C(7),$C(7),"You Have More Than One Entry For The "_BMCNAME_" In Your Package File."

 .W !,"One entry needs to be deleted."

 .W !,"Please Contact Computer Support Personnel Before Proceeding.",!!,$C(7),$C(7),$C(7)

 .D EOP^BMC

 .Q

 W !,"PACKAGE file OK..."

 ;

 ;D ^BMCPREI

 Q

BMCPRE    ; IHS/PHXAO/TMJ - PREINIT, CHK RQMNTS, ETC., DELETE DICS ;   

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 +2       ;

 +3       ;Patch #1 - Includes running this same Pre-Init Routine

 +4        NEW BMCNAME

 +5        IF '$GET(DUZ)

               KILL DIFQ

               WRITE $CHAR(7),!,"DUZ UNDEFINED OR 0."

               SET XPDQUIT=1

               QUIT 

 +6       ;IOM Variable doesn't appear to be around

           SET IOM=IO

 +7        IF '$LENGTH($GET(DUZ(0)))

               KILL DIFQ

               WRITE $CHAR(7),!,"DUZ(0) UNDEFINED OR NULL."

               SET XPDQUIT=1

               QUIT 

 +8        SET X=$PIECE(^VA(200,DUZ,0),U)

           SET BMCNAME=$PIECE($TEXT(BMCPRE+1),";",4)

 +9        WRITE !!,"Hello - Checking system requirements...."

 +10       IF $GET(^DD("VERSION"))<21

               KILL DIFQ

               WRITE $CHAR(7),!,"I NEED AT LEAST FILEMAN 21."

               SET XPDQUIT=1

               QUIT 

 +11       WRITE !,"FileMan OK.."

 +12       IF $SELECT('$ORDER(^DIC(9.4,"C","XU",0)):1,$GET(^DIC(9.4,$ORDER(^DIC(9.4,"C","XU",0)),"VERSION"))<7.1:1,1:0)

               KILL DIFQ

               WRITE !,"I NEED AT LEAST KERNEL 7.1"

               SET XPDQUIT=1

               QUIT 

 +13       WRITE !,"Kernel OK..."

 +14       SET %="STATUS"

 +15       SET X="BMC"

           SET Y="BMB"

 +16       IF '$DATA(^DIC(9.4,"C","BMC"))

               IF '$DATA(^DIC(19,"C",X))

                   IF '($EXTRACT($ORDER(^DIC(19,"B",Y)),1,4)=X)

                       IF '($EXTRACT($ORDER(^DIC(19.1,"B",Y)),1,4)=X)

                           WRITE !!,"NEW INSTALL",!

                           SET ^TMP($JOB,"BMC","NEW INSTALL")=1

                           QUIT 

 +17      ;

 +18       NEW DIC

V1        ;

 +1        WRITE !!,"Checking PACKAGE File For Duplicate "_BMCNAME_" Entries"

 +2        SET X="BMC"

           SET DIC="^DIC(9.4,"

           SET DIC(0)=""

           SET D="C"

           DO IX^DIC

 +3        IF Y<0

               Begin DoDot:1

 +4                KILL DIFQ

 +5                WRITE !!,$CHAR(7),$CHAR(7),"You Have More Than One Entry For The "_BMCNAME_" In Your Package File."

 +6                WRITE !,"One entry needs to be deleted."

 +7                WRITE !,"Please Contact Computer Support Personnel Before Proceeding.",!!,$CHAR(7),$CHAR(7),$CHAR(7)

 +8                DO EOP^BMC

 +9                QUIT 

               End DoDot:1

               SET XPDQUIT=1

               QUIT 

 +10       WRITE !,"PACKAGE file OK..."

 +11      ;

 +12      ;D ^BMCPREI

 +13       QUIT