AUM41ENV.m

AUM41ENV ;IHS/ASDST/DMJ,SDR,GTH - ICD 9 CODES FOR FY 2004 ; [ 09/17/2002  12:40 PM ]

 ;;04.1;TABLE MAINTENANCE;;SEP 28,2001

 ;

 I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q

 ;

 I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q

 ;

 S X=$P(^VA(200,DUZ,0),U)

 W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)

 W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_".",IOM)

 ;

 I $$VCHK("XU","8.0",2)

 I $$VCHK("DI","21.0",2)

 I $$VCHK("AUM","3.1",2)

 ;

 NEW DA,DIC

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

 D IX^DIC

 I Y<0,$D(^DIC(9.4,"C","AUM")) D

 . W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AUM"" prefix.",IOM)

 . W !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)

 . D SORRY(2)

 .Q

 ;

 I $G(XPDQUIT) W !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7 Q

 ;

 W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)

 D HELP^XBHELP("INTROE","AZHBENV")

 ;

 I $G(XPDENV)=1 D

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

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

 . S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0

 . D HELP^XBHELP("INTROI","AZHBENV")

 .Q

 ;

 I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2)

 Q

 ;

SORRY(X) ;

 KILL DIFQ

 S XPDQUIT=X

 W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)

 Q

 ;

VCHK(AUMPRE,AUMVER,AUMQUIT) ; Check versions needed.

 ;  

 NEW AUMV

 S AUMV=$$VERSION^XPDUTL(AUMPRE)

 W !,$$CJ^XLFSTR("Need at least "_AUMPRE_" v "_AUMVER_"....."_AUMPRE_" v "_AUMV_" Present",IOM)

 I AUMV<AUMVER KILL DIFQ S XPDQUIT=AUMQUIT D SORRY(AUMQUIT) Q 0

 Q 1

 ;

INTROE ; Intro text during KIDS Environment check.

 ;;This is the annual update to the ICD files.  There are modifications,

 ;;inactivations, and new entries to both files.

 ;;###

 ;

INTROI ; Intro text during KIDS Install.

 ;;If you run interactively, results will be displayed on your screen,

 ;;and recorded in the entry in the INSTALL file.

 ;;If you queue to TaskMan, remember not to Q to the HOME device.

 ;;###

 ;

AUM41ENV  ;IHS/ASDST/DMJ,SDR,GTH - ICD 9 CODES FOR FY 2004 ; [ 09/17/2002  12:40 PM ]

 +1       ;;04.1;TABLE MAINTENANCE;;SEP 28,2001

 +2       ;

 +3        IF '$GET(DUZ)

               WRITE !,"DUZ UNDEFINED OR 0."

               DO SORRY(2)

               QUIT 

 +4       ;

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

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

               DO SORRY(2)

               QUIT 

 +6       ;

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

 +8        WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)

 +9        WRITE !!,$$CJ^XLFSTR("Checking Environment for "_$PIECE($TEXT(+2),";",4)_" V "_$PIECE($TEXT(+2),";",3)_".",IOM)

 +10      ;

 +11       IF $$VCHK("XU","8.0",2)

 +12       IF $$VCHK("DI","21.0",2)

 +13       IF $$VCHK("AUM","3.1",2)

 +14      ;

 +15       NEW DA,DIC

 +16       SET X="AUM"

           SET DIC="^DIC(9.4,"

           SET DIC(0)=""

           SET D="C"

 +17       DO IX^DIC

 +18       IF Y<0

               IF $DATA(^DIC(9.4,"C","AUM"))

                   Begin DoDot:1

 +19                   WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AUM"" prefix.",IOM)

 +20                   WRITE !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)

 +21                   DO SORRY(2)

 +22                   QUIT 

                   End DoDot:1

 +23      ;

 +24       IF $GET(XPDQUIT)

               WRITE !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7

               QUIT 

 +25      ;

 +26       WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)

 +27       DO HELP^XBHELP("INTROE","AZHBENV")

 +28      ;

 +29       IF $GET(XPDENV)=1

               Begin DoDot:1

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

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

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

 +33               DO HELP^XBHELP("INTROI","AZHBENV")

 +34               QUIT 

               End DoDot:1

 +35      ;

 +36       IF '$$DIR^XBDIR("E","","","","","",1)

               DO SORRY(2)

 +37       QUIT 

 +38      ;

SORRY(X)  ;

 +1        KILL DIFQ

 +2        SET XPDQUIT=X

 +3        WRITE *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)

 +4        QUIT 

 +5       ;

VCHK(AUMPRE,AUMVER,AUMQUIT) ; Check versions needed.

 +1       ;  

 +2        NEW AUMV

 +3        SET AUMV=$$VERSION^XPDUTL(AUMPRE)

 +4        WRITE !,$$CJ^XLFSTR("Need at least "_AUMPRE_" v "_AUMVER_"....."_AUMPRE_" v "_AUMV_" Present",IOM)

 +5        IF AUMV<AUMVER

               KILL DIFQ

               SET XPDQUIT=AUMQUIT

               DO SORRY(AUMQUIT)

               QUIT 0

 +6        QUIT 1

 +7       ;

INTROE    ; Intro text during KIDS Environment check.

 +1       ;;This is the annual update to the ICD files.  There are modifications,

 +2       ;;inactivations, and new entries to both files.

 +3       ;;###

 +4       ;

INTROI    ; Intro text during KIDS Install.

 +1       ;;If you run interactively, results will be displayed on your screen,

 +2       ;;and recorded in the entry in the INSTALL file.

 +3       ;;If you queue to TaskMan, remember not to Q to the HOME device.

 +4       ;;###

 +5       ;