BDGENV.m

BDGENV ; IHS/ANMC/LJF - PIMS ENVIRONMENT CHECK RTN ;  [ 05/28/2004  3:18 PM ]

 ;;5.3;PIMS;;APR 26, 2002

 ;

ENV ;EP; environment check code

 ;Prevents "Disable Options..." and "Move Routines..." questions

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

 ;

 ;IHS/ITSC/WAR 5/28/2004 Added ck's for minimum RPMS patches

 W !,"** CHECKING ENVIRONMENT **",!!

 ;

 ; *** KERNEL

 ;I +$$PATCH^XPDUTL("XU*8.0*1007")'>0 D  Q

 ;. S XPDQUIT=2

 ;. W !,"You must first install patch XU*8*1007.",!

 ;

 ; *** UTILITY TABLES (standard tables)

 I +$$PATCH^XPDUTL("AUT*98.1*13")'>0 D  Q

 . S XPDQUIT=2

 . W !,"You must first install patch AUT*98.1*13.",!

 ;

 ; *** IHS PATIENT DICTIONARIES

 I +$$PATCH^XPDUTL("AUPN*99.1*13")'>0 D  Q

 . S XPDQUIT=2

 . W !,"You must first install patch AUPN*99.1*13.",!

 ;

 ; *** IHS/VA UTILITIES

 I +$$PATCH^XPDUTL("XB*3.0*9")'>0 D  Q

 . S XPDQUIT=2

 . W !,"You must first install patch XB*3.0*9.",!

 ;

 ; *** PATIENT REGISTRATION

 I +$$PATCH^XPDUTL("AG*7.0*1")'>0 D  Q

 . S XPDQUIT=2

 . W !,"You must first install patch AG*7.0*1.",!

 ;

 ; *** IHS VA SUPPORT FILES

 I +$$PATCH^XPDUTL("AVA*93.2*18")'>0 D  Q

 . S XPDQUIT=2

 . W !,"You must first install patch AVA*93.2*18.",!

 ;

 W !,"Everything looks fine!",!

 Q 

BDGENV    ; IHS/ANMC/LJF - PIMS ENVIRONMENT CHECK RTN ;  [ 05/28/2004  3:18 PM ]

 +1       ;;5.3;PIMS;;APR 26, 2002

 +2       ;

ENV       ;EP; environment check code

 +1       ;Prevents "Disable Options..." and "Move Routines..." questions

 +2        SET XPDDIQ("XPZ1")=0

           SET XPPDIQ("XPZ2")=0

 +3       ;

 +4       ;IHS/ITSC/WAR 5/28/2004 Added ck's for minimum RPMS patches

 +5        WRITE !,"** CHECKING ENVIRONMENT **",!!

 +6       ;

 +7       ; *** KERNEL

 +8       ;I +$$PATCH^XPDUTL("XU*8.0*1007")'>0 D  Q

 +9       ;. S XPDQUIT=2

 +10      ;. W !,"You must first install patch XU*8*1007.",!

 +11      ;

 +12      ; *** UTILITY TABLES (standard tables)

 +13       IF +$$PATCH^XPDUTL("AUT*98.1*13")'>0

               Begin DoDot:1

 +14               SET XPDQUIT=2

 +15               WRITE !,"You must first install patch AUT*98.1*13.",!

               End DoDot:1

               QUIT 

 +16      ;

 +17      ; *** IHS PATIENT DICTIONARIES

 +18       IF +$$PATCH^XPDUTL("AUPN*99.1*13")'>0

               Begin DoDot:1

 +19               SET XPDQUIT=2

 +20               WRITE !,"You must first install patch AUPN*99.1*13.",!

               End DoDot:1

               QUIT 

 +21      ;

 +22      ; *** IHS/VA UTILITIES

 +23       IF +$$PATCH^XPDUTL("XB*3.0*9")'>0

               Begin DoDot:1

 +24               SET XPDQUIT=2

 +25               WRITE !,"You must first install patch XB*3.0*9.",!

               End DoDot:1

               QUIT 

 +26      ;

 +27      ; *** PATIENT REGISTRATION

 +28       IF +$$PATCH^XPDUTL("AG*7.0*1")'>0

               Begin DoDot:1

 +29               SET XPDQUIT=2

 +30               WRITE !,"You must first install patch AG*7.0*1.",!

               End DoDot:1

               QUIT 

 +31      ;

 +32      ; *** IHS VA SUPPORT FILES

 +33       IF +$$PATCH^XPDUTL("AVA*93.2*18")'>0

               Begin DoDot:1

 +34               SET XPDQUIT=2

 +35               WRITE !,"You must first install patch AVA*93.2*18.",!

               End DoDot:1

               QUIT 

 +36      ;

 +37       WRITE !,"Everything looks fine!",!

 +38       QUIT