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

TIUP246.m

Go to the documentation of this file. 
  1. TIUP246 ; SLC/JER - Installer Routine for TIU*1*246 ;02/03/09  10:15
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**246**;Jun 20, 1997;Build 22
  1.  Q
  1.  ;
  1.  ;=======================================================
  1. PRE ; Pre-install - If the Exchange File entry already exists delete it.
  1.  N LVL
  1.  F LVL="DC","T" D
  1.  . N ARRAY,LUVALUE,LIST,NUM
  1.  . D EXARRAY(.ARRAY,LVL)
  1.  . S LUVALUE(1)=ARRAY(1),LUVALUE(2)=ARRAY(2)
  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.  .. N IND
  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,LVL) ; List of exchange entries used by delete and install
  1.  S ARRAY(1)=$S(LVL="T":"TIU*1*246 20090128 TL",1:"TIU*1*246 20090128 DC/TL")
  1.  S ARRAY(2)=$S(LVL="T":"01/28/2009@17:09:58",1:"01/28/2009@17:05:57")
  1.  S ARRAY(3)="O"
  1.  Q
  1.  ;
  1.  ;=======================================================
  1. POST ; Post-install.
  1.  N ACTION,EXARRAY,IEN,LUVALUE,PXRMINST,TEXT,TIUDC,TIUFPRIV,TIUFWHO
  1.  N TIUDCDA,TIUDCNM,TIUTDA,TIUETNM,TIUEDCNM,TIULVL
  1.  S TIUEDCNM="TBI/POLYTRAUMA DOCUMENTS"
  1.  S TIUETNM="TBI/POLYTRAUMA REHABILITATION/REINTEGRATION PLAN OF CARE"
  1.  S TIUDCDA=$G(XPDQUES("POS001")),TIUDCNM=$G(XPDQUES("POS001","B"))
  1.  I TIUDCNM="" S TIUDCNM=TIUEDCNM
  1.  S (PXRMINST,TIUFPRIV)=1,TIUFWHO="N"
  1.  S TIULVL=$S(TIUDCNM'=TIUEDCNM:"T",1:"DC")
  1.  D EXARRAY(.EXARRAY,TIULVL)
  1.  S LUVALUE(1)=EXARRAY(1),LUVALUE(2)=EXARRAY(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(3)
  1.  D INSTALL^PXRMEXSI(IEN,ACTION,1)
  1.  S TIUTDA=$$FIND(TIUETNM,"DOC")
  1.  I +TIUTDA'>0 D  Q
  1.  . D BMES^XPDUTL("Title """_TIUETNM_"""")
  1.  . D MES^XPDUTL("  NOT PROPERLY INSTALLED.")
  1.  ; If user specified TBI/POLYTRAUMA DOCUMENTS as preferred Document Class,
  1.  ; attach new TBI/POLYTRAUMA DOCUMENTS Document Class to Class PROGRESS NOTES
  1.  I TIUDCNM=TIUEDCNM D  I 1
  1.  . N TIUEDCDA S TIUEDCDA=$$FIND(TIUEDCNM,"DC")
  1.  . I +TIUEDCDA'>0 D BMES^XPDUTL("Document Class """_TIUEDCNM_""" NOT PROPERLY INSTALLED.") Q
  1.  . D ATTACH(TIUEDCDA,3)
  1.  ; Otherwise, attach TIU/POLYTRAUMA Title to preferred Document Class
  1.  E  D ATTACH(TIUTDA,TIUDCDA)
  1.  ;Map new TBI/POLYTRAUMA CARE PLAN Title to Enterprise Standard Title TBI/POLYTRAUMA CARE PLAN NOTE
  1.  D MAP(TIUTDA)
  1.  Q
  1.  ;
  1.  ;=======================================================
  1. FIND(TIUNM,TYPE) ; Find IEN of TBI/POLYTRAUMA Document Definition
  1.  N TIUY,POP S (POP,TIUY)=0
  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. ATTACH(TIUDA,TIUPDA) ; Attach Entry (TIUDA) to desired Parent (TIUPDA)
  1.  N ERR,IENS,FLAGS,FDA,TIUFPRIV,TIUFWHO,XQORM
  1.  S TIUFPRIV=1,TIUFWHO="N",IENS=TIUDA_","
  1.  S FLAGS="K"
  1.  S IENS="?+1,"_TIUPDA_","
  1.  S FDA(8925.14,IENS,".01")=TIUDA
  1.  D UPDATE^DIE(FLAGS,"FDA","","ERR")
  1.  ; if filing error occurs, write message to install log
  1.  I $D(ERR) D  Q
  1.  . D BMES^XPDUTL("Unable to Attach "_$P($G(^TIU(8925.1,TIUDA,0)),U)_" to "_$P($G(^TIU(8925.1,TIUPDA,0)),U))
  1.  . D MES^XPDUTL($G(ERR("DIERR",1,"TEXT",1)))
  1.  ; Re-compile menu
  1.  K ^XUTL("XQORM",TIUPDA_";TIU(8925.1,")
  1.  S XQORM=TIUPDA_";TIU(8925.1,",XQORM(0)="" D ^XQORM
  1.  Q
  1.  ;
  1.  ;=======================================================
  1. MAP(TIUDA) ; Map new TBI/POLYTRAUMA Title to Enterprise Standard Title TBI TREATMENT PLAN NOTE
  1.  N ERR,IENS,FLAGS,FDA,TIUFPRIV,TIUFWHO,TIUPROD S TIUPROD=$$PROD^XUPROD(1)
  1.  I +TIUDA'>0 D BMES^XPDUTL("TBI/POLYTRAUMA REHABILITATION/REINTEGRATION PLAN OF CARE title not installed.") Q
  1.  S TIUFPRIV=1,TIUFWHO="N",IENS=TIUDA_","
  1.  S FDA(8925.1,IENS,1501)="TBI TREATMENT PLAN 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:TIUPROD BMES^XPDUTL("Unable to map TBI/POLYTRAUMA REHABILITATION/REINTEGRATION PLAN OF CARE title") I 1
  1.  . D:TIUPROD MES^XPDUTL("  to TBI TREATMENT PLAN NOTE. You'll have to manually map the title.")
  1.  . D:TIUPROD MES^XPDUTL("  "_$G(ERR("DIERR",1,"TEXT",1)))
  1.  ; otherwise activate title
  1.  K FDA
  1.  S FDA(8925.1,IENS,".07")="ACTIVE"
  1.  S FDA(8925.1,IENS,".13")="YES"
  1.  D FILE^DIE(FLAGS,"FDA","ERR")
  1.  ; if filing error occurs, write message to install log
  1.  I $D(ERR) D  Q
  1.  . D:TIUPROD BMES^XPDUTL("Unable to Activate TBI/POLYTRAUMA TITLE.")
  1.  . D MES^XPDUTL($G(ERR("DIERR",1,"TEXT",1)))
  1.  ; finally, check for entry in "ACL" cross-reference and if missing, call EN^DIK
  1.  I +$O(^TIU(8925.1,"ACL",3,"TBI/POLYTRAUMA REHABILITATION/REINTEGRATION PLAN OF CARE",0))'>0 D
  1.  . N DIK,DA S DIK="^TIU(8925.1,",DIK(1)=".07^ACL07",DA=TIUDA D EN^DIK
  1.  Q