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