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

TIUE246.m

Go to the documentation of this file. 
  1. TIUE246 ; SLC/JER - Installer Routine for TIU*1*246 ;02/03/09  13:46
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**246**;Jun 20, 1997;Build 22
  1.  ;
  1.  ;=======================================================
  1. ENV ; Environment Check
  1.  N TIUDA
  1.  ; If install option isn't 'Install Package(s)' QUIT
  1.  Q:+$G(XPDENV)'=1
  1.  I '$$ISA^USRLM(DUZ,"CLINICAL COORDINATOR") D  Q:+$G(XPDABORT)
  1.  . N TIUY S TIUY=0
  1.  . W !,"You are not known to the system to be a Clinical Application Coordinator (CAC).",!
  1.  . W !,"Before proceeding with installation of this patch, you need to either have a"
  1.  . W !,"CAC present with you, or have consulted the CAC as to the Document Class under"
  1.  . W !,"Progress Notes in which the new TBI/POLYTRAUMA REHABILITATION/REINTEGRATION"
  1.  . W !,"PLAN OF CARE Title should be placed.",!
  1.  . S TIUY=$$READ^TIUU("YA","Are You Prepared to Continue? ","NO")
  1.  . I '+TIUY W !!,"Okay, no harm done...Hurry back with a CAC (or an answer!)" S XPDABORT=2
  1.  ; If TBI/POLYTRAUMA title is already installed, show hierarchy, and ask if OK
  1.  S TIUDA=$O(^TIU(8925.1,"B","TBI/POLYTRAUMA REHABILITATION/REINTEGRATION PLAN OF CARE",0))
  1.  I +TIUDA>0 D
  1.  . N TIUDCDA,TIUFPRIV,TIUFWHO,TIUY S TIUY=0,TIUFPRIV=1,TIUFWHO="N"
  1.  . W !!,"The TBI/POLYTRAUMA REHABILITATION/REINTEGRATION PLAN OF CARE Title has already"
  1.  . W !,"been installed on your system...",!
  1.  . S TIUDCDA=$O(^TIU(8925.1,"AD",TIUDA,0))
  1.  . I +TIUDCDA>0 D
  1.  . . W !,"It currently descends from the ",$P($G(^TIU(8925.1,TIUDCDA,0)),U)," Document Class.",!
  1.  . S TIUY=$$READ^TIUU("YA","Is this Acceptable? ","YES")
  1.  . ; If acceptable, QUIT the installation of TIU*1*246
  1.  . I +TIUY>0 S XPDQUIT=1 Q
  1.  . ; Otherwise, inactivate and remove TBI/POLYTRAUMA title from current Document Class
  1.  . D REMOVE(TIUDA,TIUDCDA)
  1.  Q
  1.  ;
  1.  ;=======================================================
  1. POS001(DIR) ; Set DIR("S") and DIR("B") for POS001.
  1.  N DFLT
  1.  S DIR("S")="I $P($G(^TIU(8925.1,+Y,0)),U,4)=""DC"",(+$P($G(^(0)),U,7)=11),+$$ISA^TIULX(+Y,3)"
  1.  S DFLT=$$FINDC
  1.  S:DFLT]"" DIR("B")=DFLT
  1.  Q
  1.  ;
  1.  ;=======================================================
  1. FINDC() ; Find an ACTIVE candidate Progress Notes DC
  1.  N TIUI,TIUY,TIUC,TIUA S (TIUC,TIUI)=0,TIUY=""
  1.  F  S TIUI=$O(^TIU(8925.1,3,10,TIUI)) Q:+TIUI'>0  D
  1.  . N TIUDA,TIUD0,TIUNM,TIUST
  1.  . S TIUDA=+$G(^TIU(8925.1,3,10,TIUI,0))
  1.  . S TIUD0=$G(^TIU(8925.1,TIUDA,0))
  1.  . S TIUST=$P(TIUD0,U,7) Q:+TIUST'=11  ; Quit if not ACTIVE
  1.  . S TIUNM=$P(TIUD0,U)
  1.  . I TIUNM["TBI"!(TIUNM["POLYTRAUMA") S TIUC=TIUC+1,TIUA(TIUC)=TIUNM
  1.  I TIUC>1 S TIUY=$G(TIUA(1))
  1.  Q TIUY
  1.  ;
  1.  ;=======================================================
  1. REMOVE(TIUDA,TIUDCDA) ; Remove Title (TIUDA) from Document Class (TIUDCDA)
  1.  N ERR,IENS,FLAGS,FDA,TIUFPRIV,TIUFWHO,TIUTDA
  1.  S TIUFPRIV=1,TIUFWHO="N",IENS=TIUDA_","
  1.  S FDA(8925.1,IENS,.07)="INACTIVE",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 INACTIVATE TBI/POLYTRAUMA REHABILITATION/REINTEGRATION PLAN OF CARE title")
  1.  . D MES^XPDUTL($G(ERR("DIERR",1,"TEXT",1)))
  1.  ; otherwise remove title from document class
  1.  K FDA
  1.  S TIUTDA=+$O(^TIU(8925.1,TIUDCDA,10,"B",TIUDA,0))
  1.  I TIUTDA'>0 D  Q
  1.  . D BMES^XPDUTL("Title "_$P($G(^TIU(8925.1,TIUDA,0)),U)_" does not descend from Document Class "_$P($G(^TIU(8925.1,TIUDCDA,0)),U)_".")
  1.  S IENS=TIUTDA_","_TIUDCDA_","
  1.  S FDA(8925.14,IENS,".01")="@",FLAGS="K"
  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 BMES^XPDUTL("Unable to Remove TBI/POLYTRAUMA TITLE from "_$P($G(^TIU(8925.1,TIUDCDA,0)),U)_".")
  1.  . D MES^XPDUTL($G(ERR("DIERR",1,"TEXT",1)))
  1.  ; If the current Document Class is left Empty, inform user and optionally delete
  1.  I +$O(^TIU(8925.1,TIUDCDA,10,0))'>0 D
  1.  . N TIUY
  1.  . W !,"Document Class ",$$PNAME^TIULC1(TIUDCDA)," is now empty...",!
  1.  . S TIUY=$$READ^TIUU("YA","Would you like to DELETE it? ","NO")
  1.  . I +TIUY=1 D DELETEDC(TIUDCDA)
  1.  Q
  1. DELETEDC(TIUDA) ; Delete empty document class
  1.  N ERR,IENS,FLAGS,FDA,TIUFPRIV,TIUFWHO,TIUDADA
  1.  S TIUFPRIV=1,TIUFWHO="N"
  1.  I +$O(^TIU(8925.1,TIUDA,10,0)) D  Q
  1.  . W !,"Document Class has descendent titles -- Can't DELETE."
  1.  ; First, remove empty DC from its parent class
  1.  D REMOVEDC(TIUDA)
  1.  ; Finally, DELETE the empty DC
  1.  S IENS=TIUDA_","
  1.  S FDA(8925.1,IENS,.07)="INACTIVE"
  1.  S FDA(8925.1,IENS,.01)="@",FLAGS="K"
  1.  D FILE^DIE(FLAGS,"FDA","ERR")
  1.  I $D(ERR) D  Q
  1.  . D BMES^XPDUTL("Unable to DELETE Document Class"_$P($G(^TIU(8925.1,TIUDA,0)),U)_".")
  1.  . D MES^XPDUTL($G(ERR("DIERR",1,"TEXT",1)))
  1.  Q
  1. REMOVEDC(TIUDA) ; Remove Empty DC from its Parent Class
  1.  N TIUDADA
  1.  S TIUDADA=$O(^TIU(8925.1,"AD",TIUDA,0))
  1.  I +TIUDADA D
  1.  . N TIUKIDA,IENS,FDA,ERR,TIUFWHO,TIUFPRIV S TIUFPRIV=1,TIUFWHO="N"
  1.  . S TIUKIDA=$O(^TIU(8925.1,"AD",TIUDA,TIUDADA,0))
  1.  . I +TIUKIDA'>0 Q
  1.  . S IENS=TIUKIDA_","_TIUDADA_","
  1.  . S FDA(8925.14,IENS,.01)="@"
  1.  . D FILE^DIE("K","FDA","ERR")
  1.  . I $D(ERR) D
  1.  . . D BMES^XPDUTL("Unable to REMOVE Document Class"_$P($G(^TIU(8925.1,TIUDA,0)),U)_" from "_$P($G(^TIU(8925.1,TIUDADA,0)),U)_".")
  1.  . . D MES^XPDUTL($G(ERR("DIERR",1,"TEXT",1)))
  1.  Q