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

TIUP242.m

Go to the documentation of this file. 
  1. TIUP242 ; SLC/JER - Installer Routine for TIU*1*242 ;08/14/2008
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**242**;Jun 20, 1997;Build 7
  1.  Q
  1.  ;=======================================================
  1. PRE ;Pre-install - If the Exchange File entry already exists delete it.
  1.  N ARRAY,IC,IND,LIST,LUVALUE,NUM
  1.  D EXARRAY(.ARRAY)
  1.  S IC=0
  1.  F  S IC=$O(ARRAY(IC)) Q:'IC  D
  1.  . S LUVALUE(1)=ARRAY(IC,1)
  1.  . D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
  1.  . I '$D(LIST) Q
  1.  . S NUM=$P(LIST("DILIST",0),U,1)
  1.  . I NUM'=0 D
  1.  .. F IND=1:1:NUM D
  1.  ... N DA,DIK
  1.  ... S DIK="^PXD(811.8,"
  1.  ... S DA=LIST("DILIST",2,IND)
  1.  ... D ^DIK
  1.  Q
  1.  ;
  1.  ;====================================================
  1. EXARRAY(ARRAY) ;List of exchange entries used by delete and install
  1.  N LN
  1.  S LN=0
  1.  ;
  1.  S LN=LN+1
  1.  S ARRAY(LN,1)="TIU*1*242 20080814"
  1.  S ARRAY(LN,2)="08/14/2008@08:20:45"
  1.  S ARRAY(LN,3)="O"
  1.  ;
  1.  Q
  1.  ;
  1.  ;==========================================
  1. POST ;Post-install.
  1.  N ACTION,EXARRAY,IC,IEN,LUVALUE,PXRMINST,TEXT,TIUDC,TIUFPRIV
  1.  S (PXRMINST,TIUFPRIV)=1
  1.  D EXARRAY(.EXARRAY)
  1.  S IC=0
  1.  F  S IC=$O(EXARRAY(IC)) Q:'IC  D
  1.  . S LUVALUE(1)=EXARRAY(IC,1),LUVALUE(2)=EXARRAY(IC,2)
  1.  . S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
  1.  . I IEN=0 D BMES^XPDUTL("Reminder Exchange entry "_LUVALUE(1)_" not properly installed.") Q
  1.  . S TEXT="Installing Reminder Exchange entry "_LUVALUE(1)
  1.  . D BMES^XPDUTL(TEXT)
  1.  . S ACTION=EXARRAY(IC,3)
  1.  . D INSTALL^PXRMEXSI(IEN,ACTION,1)
  1.  ;Map new SECURE MESSAGING Title to Enterprise Standard Title MHV DIALOG NOTE
  1.  D MAP($$DT("DOC"))
  1.  ;Attach new SECURE MESSAGING Document Class to Class PROGRESS NOTES
  1.  D ATTACH($$DT("DC"))
  1.  Q
  1.  ;
  1.  ;==========================================
  1. DT(TYPE) ; Find IEN of SECURE MESSAGING Document Class
  1.  N TIUY,POP,TIUNM S (POP,TIUY)=0,TIUNM=$S(TYPE="DOC":"SECURE MESSAGING",1:"SECURE MESSAGING DOCUMENTS")
  1.  F  S TIUY=$O(^TIU(8925.1,"B",TIUNM,TIUY)) Q:+TIUY'>0  D  Q:POP
  1.  . I $P($G(^TIU(8925.1,+TIUY,0)),U,4)=TYPE S POP=1
  1.  Q TIUY
  1.  ;
  1.  ;==========================================
  1. MAP(TIUDA) ; Map new SECURE MESSAGING Title to Enterprise Standard Title MHV DIALOG NOTE
  1.  N ERR,IENS,FLAGS,FDA,TIUFPRIV
  1.  I +TIUDA'>0 D BMES^XPDUTL("SECURE MESSAGING TITLE NOT PROPERLY INSTALLED.") Q
  1.  S TIUFPRIV=1,IENS=TIUDA_","
  1.  S FDA(8925.1,IENS,1501)="MHV DIALOG NOTE"
  1.  S FDA(8925.1,IENS,1502)=$$FMTE^XLFDT($$NOW^XLFDT)
  1.  S FDA(8925.1,IENS,1503)="`"_DUZ
  1.  S FLAGS="ET"
  1.  D FILE^DIE(FLAGS,"FDA","ERR")
  1.  ; if filing error occurs, write message to install log & quit
  1.  I $D(ERR) D  Q
  1.  . D BMES^XPDUTL("Unable to map SECURE MESSAGING TITLE to MHV DIALOG NOTE - Please notify CAC.")
  1.  ; otherwise activate title
  1.  K FDA
  1.  S FDA(8925.1,IENS,".07")="ACTIVE"
  1.  D FILE^DIE(FLAGS,"FDA","ERR")
  1.  ; if filing error occurs, write message to install log
  1.  I $D(ERR) D
  1.  . D BMES^XPDUTL("Unable to activate SECURE MESSAGING TITLE - Please notify CAC.")
  1.  Q
  1.  ;
  1.  ;==========================================
  1. ATTACH(TIUDA) ; Attach new SECURE MESSAGING Document Class to Class PROGRESS NOTES
  1.  N D,D0,DI,DIY,DQ,DA,DIC,DLAYGO,DIE,DR,I,TIUI,TIUFPRIV,X,Y,XQORM
  1.  I +TIUDA'>0 D BMES^XPDUTL("SECURE MESSAGING DOCUMENT CLASS NOT PROPERLY INSTALLED.") Q
  1.  S TIUFPRIV=1
  1.  S DIC="^TIU(8925.1,3,10,",DLAYGO=8925.14,DIC(0)="LNX"
  1.  S X="`"_TIUDA,DA(1)=3
  1.  D ^DIC Q:+Y'>0
  1.  S TIUI=$P(^TIU(8925.1,3,10,0),U,4)
  1.  S DA(1)=3,DA=+Y,DIE=DIC
  1.  S DR="4////Secure Messaging"
  1.  D ^DIE
  1.  ; Serialize menu items
  1.  S (DA,TIUI)=0
  1.  F  S DA=$O(^TIU(8925.1,3,10,DA)) Q:+DA'>0  D
  1.  . S TIUI=TIUI+1,DR="2////^S X=TIUI;3////^S X=TIUI" D ^DIE
  1.  ; Re-compile menu
  1.  K ^XUTL("XQORM","3;TIU(8925.1,")
  1.  S XQORM="3;TIU(8925.1,",XQORM(0)="" D ^XQORM
  1.  Q