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

BTIUP2.m

Go to the documentation of this file. 
  1. BTIUP2 ; IHS/ITSC/LJF - POST INSTALL FOR PATCH 1002
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**1002**;NOV 04, 2004
  1.  ;
  1. ENV ;EP environment check
  1.  S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  ;
  1.  S PATCH="TIU*1.0*1001"
  1.  I '$$PATCH(PATCH) D  Q
  1.  . W !,"You must first install "_PATCH_"." S XPDQUIT=2
  1.  Q
  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. CLEAN ; clean out BTIU OBJECT DESCRIPTION file before restoring data
  1.  NEW X
  1.  S X=0 F  S X=$O(^BTIUOD(X)) Q:'X  K ^BTIUOD(X)
  1.  K ^BTIUOD("B")
  1.  S $P(^BTIUOD(0),U,3,4)="0^0"
  1.  Q
  1.  ;
  1. POST ;EP; beginning of post install code
  1.  D OBJCHK,DOCDEF,OBJFIX
  1.  Q
  1.  ;
  1. OBJCHK ; clean up object description file .01 pointers
  1.  NEW IEN,DIE,PNAME,SNAME,PTR,DR,DA
  1.  S DIE="^BTIUOD("
  1.  S IEN=0 F  S IEN=$O(^BTIUOD(IEN)) Q:'IEN  D
  1.  . S PNAME=$$GET1^DIQ(9003130.1,IEN,.01)     ;name based on pointer
  1.  . S SNAME=$$GET1^DIQ(9003130.1,IEN,.02)     ;name as stored in .02 field
  1.  . I PNAME=SNAME Q                           ;skip if names match - installed ok
  1.  . ;
  1.  . S PTR=$O(^TIU(8925.1,"B",SNAME,0)) I PTR D   ;find correct pointer
  1.  . . I $$GET1^DIQ(8925.1,PTR,.04)'="OBJECT" Q   ;make sure it is an object
  1.  . . S DR=".01///`"_PTR,DA=IEN
  1.  . . D ^DIE                                     ;then fix it
  1.  Q
  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
  1.  ;
  1. OBJFIX ; fix definition of objects previously sent
  1.  NEW I,NAME,IEN
  1.  F I=1:1 Q:$P($T(OBJECT+I),";;",2)=""  S NAME=$P($T(OBJECT+I),";;",2) D
  1.  . S IEN=$O(^TIU(8925.1,"B",NAME,0))
  1.  . I IEN S ^TIU(8925.1,IEN,9)=$P($T(OBJECT+I),";;",3)
  1.  Q
  1.  ;
  1. OBJECT ;;
  1.  ;;LAST BP;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"BP",0,1);;
  1.  ;;LAST HEIGHT-DETAILED;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"HT",0,1);;
  1.  ;;LAST PAIN;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"PA",0,1);;
  1.  ;;LAST PULSE;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"PU",0,1);;
  1.  ;;LAST RESPIRATION;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"RS",0,1);;
  1.  ;;LAST TEMPERATURE;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"TMP",0,1);;
  1.  ;;LAST WEIGHT - DETAILED;;S X=$$LASTMSR^BTIUPCC1(+$G(DFN),"WT",0,1);;
  1.  ;;TIU HEADER;;S X=$S($L($T(LIST^CIAOTIUH)):$$LIST^CIAOTIUH(DFN,"^TMP(""TIUFLD"",$J)"),1:"");;
  1.  ;;VCDICTATE NOTE IEN;;S X=$S($L($T(IEN^CIAOTIUH)):$$IEN^CIAOTIUH("CIAOTIUD"),1:"");;
  1.  ;;VITALS FOR VISIT CONTEXT;;S X=$$VMSRD^BTIULO4("TMP(""VUECC"",$J)");;