Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BTIUP6

BTIUP6.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ENV ;EP environment check
  1. N PATCH
  1. S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1. ;
  1. S PATCH="TIU*1.0*1005"
  1. I '$$PATCH(PATCH) D Q
  1. . W !,"You must first install "_PATCH_"." S XPDQUIT=2
  1. ;Check for PCC patches
  1. S IN="IHS PCC SUITE 2.0",INSTDA=""
  1. I '$D(^XPD(9.7,"B",IN)) D Q
  1. .W !,"You must first install the IHS PCC SUITE version 2.0 before installing TIU patch 1006" S XPDQUIT=2
  1. S INSTDA=$O(^XPD(9.7,"B",IN,INSTDA),-1)
  1. S STAT=+$P($G(^XPD(9.7,INSTDA,0)),U,9)
  1. I STAT'=3 D Q
  1. .W !,"IHS PCC SUITE 2.0 must be completely installed before installing TIU patch 1006" S XPDQUIT=2
  1. S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1. ;Check for patch 6 of the EHR
  1. S IN="EHR*1.1*6",INSTDA=""
  1. I '$D(^XPD(9.7,"B",IN)) D Q
  1. .W !,"You must first install the EHR patch 6 before installing patch TIU patch 1006" S XPDQUIT=2
  1. S INSTDA=$O(^XPD(9.7,"B",IN,INSTDA),-1)
  1. S STAT=+$P($G(^XPD(9.7,INSTDA,0)),U,9)
  1. I STAT'=3 D Q
  1. .W !,"EHR patch 6 must be completely installed before installing TIU patch 1006" S XPDQUIT=2
  1. S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1. ;
  1. 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
  1. Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N 0
  1. NEW NUM,I,J
  1. S I=$O(^DIC(9.4,"C",$P(X,"*"),0)) Q:'I 0
  1. S J=$O(^DIC(9.4,I,22,"B",$P(X,"*",2),0)),X=$P(X,"*",3) Q:'J 0
  1. ;check if patch is just a number
  1. Q:$O(^DIC(9.4,I,22,J,"PAH","B",X,0)) 1
  1. S NUM=$O(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
  1. Q (X=+NUM)
  1. ;
  1. PRE ;EP; beginning of pre install code
  1. Q
  1. ;
  1. POST ;EP; beginning of post install code
  1. D DOCDEF
  1. Q
  1. ;
  1. ;
  1. DOCDEF ; clean up any dangling pointers in Document Definition file
  1. NEW DOC,ITEM,PTR,SEQ,TEXT
  1. S DOC=0 F S DOC=$O(^TIU(8925.1,DOC)) Q:'DOC D
  1. . Q:'$O(^TIU(8925.1,DOC,10,0)) ;no items
  1. . S ITEM=0
  1. . F S ITEM=$O(^TIU(8925.1,DOC,10,ITEM)) Q:'ITEM D
  1. . . S PTR=$P(^TIU(8925.1,DOC,10,ITEM,0),U) ;item pointer
  1. . . Q:$D(^TIU(8925.1,PTR,0)) ;skip if good pointer
  1. . . S SEQ=$P(^TIU(8925.1,DOC,10,ITEM,0),U,3) ;sequence
  1. . . S TEXT=$P(^TIU(8925.1,DOC,10,ITEM,0),U,4) ;menu text
  1. . . ;
  1. . . ; kill cross-references and main item entry
  1. . . K ^TIU(8925.1,DOC,10,"B",PTR,ITEM)
  1. . . I SEQ]"" K ^TIU(8925.1,DOC,10,"AC",SEQ,ITEM)
  1. . . I TEXT]"" K ^TIU(8925.1,DOC,10,"C",TEXT,ITEM)
  1. . . K ^TIU(8925.1,DOC,10,ITEM)
  1. Q