BMEPRE.m

BMEPRE ; IHS/PHXAO/TMJ - MEDICAID ELIGIBILITY DOWNLOAD PREINIT, CHK RQMNTS, ETC., DELETE DICS ;    [ 06/25/03  9:59 AM ]

 ;;1.0T1;MEDICAID ELIGIBLITITY DOWNLOAD;;JUNE 25, 2003

 NEW BMENAME

 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),BMENAME=$P($T(BMEPRE+1),";",4)

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

 I $G(^DD("VERSION"))<22 K DIFQ W $C(7),!,"I NEED AT LEAST FILEMAN 22." 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"))<8.0:1,1:0) K DIFQ W !,"I NEED AT LEAST KERNEL 8.0" S XPDQUIT=1 Q

 W !,"Kernel OK..."

 S %="STATUS"

 S X="BME",Y="BMB"

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

 ;

 NEW DIC

V1 ;

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

 S X="BME",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 "_BMENAME_" 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^BME

 .Q

 W !,"PACKAGE file OK..."

 ;

 ;D ^BMEPREI

 Q

BMEPRE    ; IHS/PHXAO/TMJ - MEDICAID ELIGIBILITY DOWNLOAD PREINIT, CHK RQMNTS, ETC., DELETE DICS ;    [ 06/25/03  9:59 AM ]

 +1       ;;1.0T1;MEDICAID ELIGIBLITITY DOWNLOAD;;JUNE 25, 2003

 +2        NEW BMENAME

 +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 BMENAME=$PIECE($TEXT(BMEPRE+1),";",4)

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

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

               KILL DIFQ

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

               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"))<8.0:1,1:0)

               KILL DIFQ

               WRITE !,"I NEED AT LEAST KERNEL 8.0"

               SET XPDQUIT=1

               QUIT 

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

 +12       SET %="STATUS"

 +13       SET X="BME"

           SET Y="BMB"

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

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

                           QUIT 

 +15      ;

 +16       NEW DIC

V1        ;

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

 +2        SET X="BME"

           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 "_BMENAME_" 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       ;D EOP^BME

 +9                QUIT 

               End DoDot:1

               SET XPDQUIT=1

               QUIT 

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

 +11      ;

 +12      ;D ^BMEPREI

 +13       QUIT