BTIUP2 ; IHS/ITSC/LJF - POST INSTALL FOR PATCH 1002
;;1.0;TEXT INTEGRATION UTILITIES;**1002**;NOV 04, 2004
;
ENV ;EP environment check
S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
;
S PATCH="TIU*1.0*1001"
I '$$PATCH(PATCH) D Q
. 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)
;
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; beginning 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
NEW I,NAME,IEN
F I=1:1 Q:$P($T(OBJECT+I),";;",2)="" S NAME=$P($T(OBJECT+I),";;",2) D
. S IEN=$O(^TIU(8925.1,"B",NAME,0))
. I IEN S ^TIU(8925.1,IEN,9)=$P($T(OBJECT+I),";;",3)
Q
;
OBJECT ;;
;;LAST BP;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"BP",0,1);;
;;LAST HEIGHT-DETAILED;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"HT",0,1);;
;;LAST PAIN;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"PA",0,1);;
;;LAST PULSE;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"PU",0,1);;
;;LAST RESPIRATION;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"RS",0,1);;
;;LAST TEMPERATURE;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"TMP",0,1);;
;;LAST WEIGHT - DETAILED;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"WT",0,1);;
;;TIU HEADER;;S X=$S($L($T(LIST^CIAOTIUH)):$$LIST^CIAOTIUH(DFN,"^TMP(""TIUFLD"",$J)"),1:"");;
;;VCDICTATE NOTE IEN;;S X=$S($L($T(IEN^CIAOTIUH)):$$IEN^CIAOTIUH("CIAOTIUD"),1:"");;
;;VITALS FOR VISIT CONTEXT;;S X=$$VMSRD^BTIULO4("TMP(""VUECC"",$J)");;
BTIUP2 ; IHS/ITSC/LJF - POST INSTALL FOR PATCH 1002
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1002**;NOV 04, 2004
+2 ;
ENV ;EP environment check
+1 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+2 ;
+3 SET PATCH="TIU*1.0*1001"
+4 IF '$$PATCH(PATCH)
Begin DoDot:1
+5 WRITE !,"You must first install "_PATCH_"."
SET XPDQUIT=2
End DoDot:1
QUIT
+6 QUIT
+7 ;
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
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; beginning 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 NEW I,NAME,IEN
+2 FOR I=1:1
IF $PIECE($TEXT(OBJECT+I),";;",2)=""
QUIT
SET NAME=$PIECE($TEXT(OBJECT+I),";;",2)
Begin DoDot:1
+3 SET IEN=$ORDER(^TIU(8925.1,"B",NAME,0))
+4 IF IEN
SET ^TIU(8925.1,IEN,9)=$PIECE($TEXT(OBJECT+I),";;",3)
End DoDot:1
+5 QUIT
+6 ;
OBJECT ;;
+1 ;;LAST BP;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"BP",0,1);;
+2 ;;LAST HEIGHT-DETAILED;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"HT",0,1);;
+3 ;;LAST PAIN;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"PA",0,1);;
+4 ;;LAST PULSE;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"PU",0,1);;
+5 ;;LAST RESPIRATION;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"RS",0,1);;
+6 ;;LAST TEMPERATURE;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"TMP",0,1);;
+7 ;;LAST WEIGHT - DETAILED;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"WT",0,1);;
+8 ;;TIU HEADER;;S X=$S($L($T(LIST^CIAOTIUH)):$$LIST^CIAOTIUH(DFN,"^TMP(""TIUFLD"",$J)"),1:"");;
+9 ;;VCDICTATE NOTE IEN;;S X=$S($L($T(IEN^CIAOTIUH)):$$IEN^CIAOTIUH("CIAOTIUD"),1:"");;
+10 ;;VITALS FOR VISIT CONTEXT;;S X=$$VMSRD^BTIULO4("TMP(""VUECC"",$J)");;
