BTIUP6 ; IHS/CIA/MGH - POST INSTALL FOR PATCH 1006;02-Feb-2010 13:27;MGH
;;1.0;TEXT INTEGRATION UTILITIES;**1006**;SEPT 04, 2005
;
ENV ;EP environment check
N PATCH
S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
;
S PATCH="TIU*1.0*1005"
I '$$PATCH(PATCH) D Q
. W !,"You must first install "_PATCH_"." S XPDQUIT=2
;Check for PCC patches
S IN="IHS PCC SUITE 2.0",INSTDA=""
I '$D(^XPD(9.7,"B",IN)) D Q
.W !,"You must first install the IHS PCC SUITE version 2.0 before installing TIU patch 1006" S XPDQUIT=2
S INSTDA=$O(^XPD(9.7,"B",IN,INSTDA),-1)
S STAT=+$P($G(^XPD(9.7,INSTDA,0)),U,9)
I STAT'=3 D Q
.W !,"IHS PCC SUITE 2.0 must be completely installed before installing TIU patch 1006" S XPDQUIT=2
S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
;Check for patch 6 of the EHR
S IN="EHR*1.1*6",INSTDA=""
I '$D(^XPD(9.7,"B",IN)) D Q
.W !,"You must first install the EHR patch 6 before installing patch TIU patch 1006" S XPDQUIT=2
S INSTDA=$O(^XPD(9.7,"B",IN,INSTDA),-1)
S STAT=+$P($G(^XPD(9.7,INSTDA,0)),U,9)
I STAT'=3 D Q
.W !,"EHR patch 6 must be completely installed before installing TIU patch 1006" S XPDQUIT=2
S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
;
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)
;
PRE ;EP; beginning of pre install code
Q
;
POST ;EP; beginning of post install code
D DOCDEF
Q
;
;
DOCDEF ; clean up any dangling pointers in Document Definition file
NEW DOC,ITEM,PTR,SEQ,TEXT
S DOC=0 F S DOC=$O(^TIU(8925.1,DOC)) Q:'DOC D
. Q:'$O(^TIU(8925.1,DOC,10,0)) ;no items
. S ITEM=0
. F S ITEM=$O(^TIU(8925.1,DOC,10,ITEM)) Q:'ITEM D
. . S PTR=$P(^TIU(8925.1,DOC,10,ITEM,0),U) ;item pointer
. . Q:$D(^TIU(8925.1,PTR,0)) ;skip if good pointer
. . S SEQ=$P(^TIU(8925.1,DOC,10,ITEM,0),U,3) ;sequence
. . S TEXT=$P(^TIU(8925.1,DOC,10,ITEM,0),U,4) ;menu text
. . ;
. . ; kill cross-references and main item entry
. . K ^TIU(8925.1,DOC,10,"B",PTR,ITEM)
. . I SEQ]"" K ^TIU(8925.1,DOC,10,"AC",SEQ,ITEM)
. . I TEXT]"" K ^TIU(8925.1,DOC,10,"C",TEXT,ITEM)
. . K ^TIU(8925.1,DOC,10,ITEM)
Q
BTIUP6 ; IHS/CIA/MGH - POST INSTALL FOR PATCH 1006;02-Feb-2010 13:27;MGH
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1006**;SEPT 04, 2005
+2 ;
ENV ;EP environment check
+1 NEW PATCH
+2 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+3 ;
+4 SET PATCH="TIU*1.0*1005"
+5 IF '$$PATCH(PATCH)
Begin DoDot:1
+6 WRITE !,"You must first install "_PATCH_"."
SET XPDQUIT=2
End DoDot:1
QUIT
+7 ;Check for PCC patches
+8 SET IN="IHS PCC SUITE 2.0"
SET INSTDA=""
+9 IF '$DATA(^XPD(9.7,"B",IN))
Begin DoDot:1
+10 WRITE !,"You must first install the IHS PCC SUITE version 2.0 before installing TIU patch 1006"
SET XPDQUIT=2
End DoDot:1
QUIT
+11 SET INSTDA=$ORDER(^XPD(9.7,"B",IN,INSTDA),-1)
+12 SET STAT=+$PIECE($GET(^XPD(9.7,INSTDA,0)),U,9)
+13 IF STAT'=3
Begin DoDot:1
+14 WRITE !,"IHS PCC SUITE 2.0 must be completely installed before installing TIU patch 1006"
SET XPDQUIT=2
End DoDot:1
QUIT
+15 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+16 ;Check for patch 6 of the EHR
+17 SET IN="EHR*1.1*6"
SET INSTDA=""
+18 IF '$DATA(^XPD(9.7,"B",IN))
Begin DoDot:1
+19 WRITE !,"You must first install the EHR patch 6 before installing patch TIU patch 1006"
SET XPDQUIT=2
End DoDot:1
QUIT
+20 SET INSTDA=$ORDER(^XPD(9.7,"B",IN,INSTDA),-1)
+21 SET STAT=+$PIECE($GET(^XPD(9.7,INSTDA,0)),U,9)
+22 IF STAT'=3
Begin DoDot:1
+23 WRITE !,"EHR patch 6 must be completely installed before installing TIU patch 1006"
SET XPDQUIT=2
End DoDot:1
QUIT
+24 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+25 ;
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 ;
PRE ;EP; beginning of pre install code
+1 QUIT
+2 ;
POST ;EP; beginning of post install code
+1 DO DOCDEF
+2 QUIT
+3 ;
+4 ;
DOCDEF ; clean up any dangling pointers in Document Definition file
+1 NEW DOC,ITEM,PTR,SEQ,TEXT
+2 SET DOC=0
FOR
SET DOC=$ORDER(^TIU(8925.1,DOC))
IF 'DOC
QUIT
Begin DoDot:1
+3 ;no items
IF '$ORDER(^TIU(8925.1,DOC,10,0))
QUIT
+4 SET ITEM=0
+5 FOR
SET ITEM=$ORDER(^TIU(8925.1,DOC,10,ITEM))
IF 'ITEM
QUIT
Begin DoDot:2
+6 ;item pointer
SET PTR=$PIECE(^TIU(8925.1,DOC,10,ITEM,0),U)
+7 ;skip if good pointer
IF $DATA(^TIU(8925.1,PTR,0))
QUIT
+8 ;sequence
SET SEQ=$PIECE(^TIU(8925.1,DOC,10,ITEM,0),U,3)
+9 ;menu text
SET TEXT=$PIECE(^TIU(8925.1,DOC,10,ITEM,0),U,4)
+10 ;
+11 ; kill cross-references and main item entry
+12 KILL ^TIU(8925.1,DOC,10,"B",PTR,ITEM)
+13 IF SEQ]""
KILL ^TIU(8925.1,DOC,10,"AC",SEQ,ITEM)
+14 IF TEXT]""
KILL ^TIU(8925.1,DOC,10,"C",TEXT,ITEM)
+15 KILL ^TIU(8925.1,DOC,10,ITEM)
End DoDot:2
End DoDot:1
+16 QUIT
