BDGP1002.m

BDGP1002 ;NEW PROGRAM [ 04/06/2005  2:49 PM ]

 ;;5.3;PIMS;**1002**;MAR 24, 2005

 ;

CKENV ; environment check code

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

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

 ;

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

 NEW BDGREC,VER,X

 S VER=$$VERSION^XPDUTL("PIMS")

 ;

 I VER'=5.3 D                  ;Not v5.3 or 'v' is 5.3t something

 . W !,"You must first install PIMS v5.3"

 .;

 . I VER["t"!(VER["T") D

 ..W !!,"Your site has a 't' version of PIMS loaded -> ",VER

 ..W !,"Please load v5.3 at your earliest convience."

 .;

 . W !!,"And, PIMS v5.3 patch 1 before this patch can be installed",!

 . S XPDQUIT=2

 ;

 ; now check for patch 1001

 S PATCH="PIMS*5.3*1001"

 I '$$PATCH(PATCH) D

 . W !,"You must first install "_PATCH_"." S XPDQUIT=2

 Q

PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnnn

 ;copy of code from XPDUTL but modified to handle 4 digit IHS patch numbers

 Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N 0

 NEW NUM,I,J

 S I=$O(^DIC(9.4,"C",$P(X,"*"),0)) Q:'I 0

 S J=$O(^DIC(9.4,I,22,"B",$P(X,"*",2),0)),X=$P(X,"*",3) Q:'J 0

 ;check if patch is just a number

 Q:$O(^DIC(9.4,I,22,J,"PAH","B",X,0)) 1

 S NUM=$O(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))

 Q (X=+NUM)

 Q

BDGP1002  ;NEW PROGRAM [ 04/06/2005  2:49 PM ]

 +1       ;;5.3;PIMS;**1002**;MAR 24, 2005

 +2       ;

CKENV     ; environment check code

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

 +2        SET XPDDIQ("XPZ1")=0

           SET XPPDIQ("XPZ2")=0

 +3       ;

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

 +5        NEW BDGREC,VER,X

 +6        SET VER=$$VERSION^XPDUTL("PIMS")

 +7       ;

 +8       ;Not v5.3 or 'v' is 5.3t something

           IF VER'=5.3

               Begin DoDot:1

 +9                WRITE !,"You must first install PIMS v5.3"

 +10      ;

 +11               IF VER["t"!(VER["T")

                       Begin DoDot:2

 +12                       WRITE !!,"Your site has a 't' version of PIMS loaded -> ",VER

 +13                       WRITE !,"Please load v5.3 at your earliest convience."

                       End DoDot:2

 +14      ;

 +15               WRITE !!,"And, PIMS v5.3 patch 1 before this patch can be installed",!

 +16               SET XPDQUIT=2

               End DoDot:1

 +17      ;

 +18      ; now check for patch 1001

 +19       SET PATCH="PIMS*5.3*1001"

 +20       IF '$$PATCH(PATCH)

               Begin DoDot:1

 +21               WRITE !,"You must first install "_PATCH_"."

                   SET XPDQUIT=2

               End DoDot:1

 +22       QUIT 

PATCH(X)  ;return 1 if patch X was installed, X=aaaa*nn.nn*nnnn

 +1       ;copy of code from XPDUTL but modified to handle 4 digit IHS patch numbers

 +2        IF X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N

               QUIT 0

 +3        NEW NUM,I,J

 +4        SET I=$ORDER(^DIC(9.4,"C",$PIECE(X,"*"),0))

           IF 'I

               QUIT 0

 +5        SET J=$ORDER(^DIC(9.4,I,22,"B",$PIECE(X,"*",2),0))

           SET X=$PIECE(X,"*",3)

           IF 'J

               QUIT 0

 +6       ;check if patch is just a number

 +7        IF $ORDER(^DIC(9.4,I,22,J,"PAH","B",X,0))

               QUIT 1

 +8        SET NUM=$ORDER(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))

 +9        QUIT (X=+NUM)

 +10       QUIT