BRNPRE.m

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

 ;;2.0;RELEASE OF INFO SYSTEM;;APR 10, 2003

 NEW BRNNAME

 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),BRNNAME=$P($T(BRNPRE+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="BRN",Y="BMB"

 I '$D(^DIC(9.4,"C","BRN")),'$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,"BRN","NEW INSTALL")=1 Q

 ;

 NEW DIC

V1 ;

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

 S X="BRN",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 "_BRNNAME_" 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^BRN

 .Q

 W !,"PACKAGE file OK..."

 ;

 ;D ^BRNPREI

 Q

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

 +1       ;;2.0;RELEASE OF INFO SYSTEM;;APR 10, 2003

 +2        NEW BRNNAME

 +3        IF '$GET(DUZ)

               KILL DIFQ

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

               SET XPDQUIT=1

               QUIT 

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

           SET IOM=IO

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

               KILL DIFQ

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

               SET XPDQUIT=1

               QUIT 

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

           SET BRNNAME=$PIECE($TEXT(BRNPRE+1),";",4)

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

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

               KILL DIFQ

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

               SET XPDQUIT=1

               QUIT 

 +9        WRITE !,"FileMan OK.."

 +10       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 

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

 +12       SET %="STATUS"

 +13       SET X="BRN"

           SET Y="BMB"

 +14       IF '$DATA(^DIC(9.4,"C","BRN"))

               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,"BRN","NEW INSTALL")=1

                           QUIT 

 +15      ;

 +16       NEW DIC

V1        ;

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

 +2        SET X="BRN"

           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 "_BRNNAME_" 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^BRN

 +9                QUIT 

               End DoDot:1

               SET XPDQUIT=1

               QUIT 

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

 +11      ;

 +12      ;D ^BRNPREI

 +13       QUIT