- 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
