BTIUP1 ; IHS/ITSC/LJF - PRE-INSTALL ROUTINE FOR TIU PATCH 1001 ;
;;1.0;TEXT INTEGRATION UTILITIES;**1001**;NOV 04, 2004
;
ENV ;EP; envorinment check
S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
;
;Check for released version added IHS/ITSC/LJF 12/10/2004
NEW IEN,PKG S PKG="TEXT INTEGRATION UTILITIES-IHS 1.0",IEN=$O(^XPD(9.6,"B",PKG,0))
I 'IEN W !,"You must first install "_PKG_"." S XPDQUIT=2 Q
I $$GET1^DIQ(9.6,IEN,.02,"I")'=3041110 D Q
. W !,"You have a test version of "_PKG_" installed."
. W !?5,"Please install the released version first."
. S XPDQUIT=2
;
Q
;
PRE ;EP; beginning of pre install code
CLEAN ; clean out BTIU OBJECT DESCRIPTION file before restoring data
NEW X
S X=0 F S X=$O(^BTIUOD(X)) Q:'X K ^BTIUOD(X)
K ^BTIUOD("B")
S $P(^BTIUOD(0),U,3,4)="0^0"
Q
;
POST ;EP; beginnig of post install code
D OBJCHK,DOCDEF,OBJFIX
Q
;
OBJCHK ; clean up object description file .01 pointers
NEW IEN,DIE,PNAME,SNAME,PTR,DR,DA
S DIE="^BTIUOD("
S IEN=0 F S IEN=$O(^BTIUOD(IEN)) Q:'IEN D
. S PNAME=$$GET1^DIQ(9003130.1,IEN,.01) ;name based on pointer
. S SNAME=$$GET1^DIQ(9003130.1,IEN,.02) ;name as stored in .02 field
. I PNAME=SNAME Q ;skip if names match - installed ok
. ;
. S PTR=$O(^TIU(8925.1,"B",SNAME,0)) I PTR D ;find correct pointer
. . I $$GET1^DIQ(8925.1,PTR,.04)'="OBJECT" Q ;make sure it is an object
. . S DR=".01///`"_PTR,DA=IEN
. . D ^DIE ;then fix it
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
;
OBJFIX ; fix definition of objects previously sent
S DA=$O(^TIU(8925.1,"B","VITALS FOR TODAY",0))
I DA S ^TIU(8925.1,DA,9)="S X=$$TODAYVIT^BTIULO7(+$G(DFN))"
Q
BTIUP1 ; IHS/ITSC/LJF - PRE-INSTALL ROUTINE FOR TIU PATCH 1001 ;
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1001**;NOV 04, 2004
+2 ;
ENV ;EP; envorinment check
+1 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+2 ;
+3 ;Check for released version added IHS/ITSC/LJF 12/10/2004
+4 NEW IEN,PKG
SET PKG="TEXT INTEGRATION UTILITIES-IHS 1.0"
SET IEN=$ORDER(^XPD(9.6,"B",PKG,0))
+5 IF 'IEN
WRITE !,"You must first install "_PKG_"."
SET XPDQUIT=2
QUIT
+6 IF $$GET1^DIQ(9.6,IEN,.02,"I")'=3041110
Begin DoDot:1
+7 WRITE !,"You have a test version of "_PKG_" installed."
+8 WRITE !?5,"Please install the released version first."
+9 SET XPDQUIT=2
End DoDot:1
QUIT
+10 ;
+11 QUIT
+12 ;
PRE ;EP; beginning of pre install code
CLEAN ; clean out BTIU OBJECT DESCRIPTION file before restoring data
+1 NEW X
+2 SET X=0
FOR
SET X=$ORDER(^BTIUOD(X))
IF 'X
QUIT
KILL ^BTIUOD(X)
+3 KILL ^BTIUOD("B")
+4 SET $PIECE(^BTIUOD(0),U,3,4)="0^0"
+5 QUIT
+6 ;
POST ;EP; beginnig of post install code
+1 DO OBJCHK
DO DOCDEF
DO OBJFIX
+2 QUIT
+3 ;
OBJCHK ; clean up object description file .01 pointers
+1 NEW IEN,DIE,PNAME,SNAME,PTR,DR,DA
+2 SET DIE="^BTIUOD("
+3 SET IEN=0
FOR
SET IEN=$ORDER(^BTIUOD(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+4 ;name based on pointer
SET PNAME=$$GET1^DIQ(9003130.1,IEN,.01)
+5 ;name as stored in .02 field
SET SNAME=$$GET1^DIQ(9003130.1,IEN,.02)
+6 ;skip if names match - installed ok
IF PNAME=SNAME
QUIT
+7 ;
+8 ;find correct pointer
SET PTR=$ORDER(^TIU(8925.1,"B",SNAME,0))
IF PTR
Begin DoDot:2
+9 ;make sure it is an object
IF $$GET1^DIQ(8925.1,PTR,.04)'="OBJECT"
QUIT
+10 SET DR=".01///`"_PTR
SET DA=IEN
+11 ;then fix it
DO ^DIE
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
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
+17 ;
OBJFIX ; fix definition of objects previously sent
+1 SET DA=$ORDER(^TIU(8925.1,"B","VITALS FOR TODAY",0))
+2 IF DA
SET ^TIU(8925.1,DA,9)="S X=$$TODAYVIT^BTIULO7(+$G(DFN))"
+3 QUIT
