TIUP246 ; SLC/JER - Installer Routine for TIU*1*246 ;02/03/09 10:15
;;1.0;TEXT INTEGRATION UTILITIES;**246**;Jun 20, 1997;Build 22
Q
;
;=======================================================
PRE ; Pre-install - If the Exchange File entry already exists delete it.
N LVL
F LVL="DC","T" D
. N ARRAY,LUVALUE,LIST,NUM
. D EXARRAY(.ARRAY,LVL)
. S LUVALUE(1)=ARRAY(1),LUVALUE(2)=ARRAY(2)
. D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
. I '$D(LIST) Q
. S NUM=$P(LIST("DILIST",0),U,1)
. I NUM'=0 D
.. N IND
.. F IND=1:1:NUM D
... N DA,DIK
... S DIK="^PXD(811.8,"
... S DA=LIST("DILIST",2,IND)
... D ^DIK
Q
;
;=======================================================
EXARRAY(ARRAY,LVL) ; List of exchange entries used by delete and install
S ARRAY(1)=$S(LVL="T":"TIU*1*246 20090128 TL",1:"TIU*1*246 20090128 DC/TL")
S ARRAY(2)=$S(LVL="T":"01/28/2009@17:09:58",1:"01/28/2009@17:05:57")
S ARRAY(3)="O"
Q
;
;=======================================================
POST ; Post-install.
N ACTION,EXARRAY,IEN,LUVALUE,PXRMINST,TEXT,TIUDC,TIUFPRIV,TIUFWHO
N TIUDCDA,TIUDCNM,TIUTDA,TIUETNM,TIUEDCNM,TIULVL
S TIUEDCNM="TBI/POLYTRAUMA DOCUMENTS"
S TIUETNM="TBI/POLYTRAUMA REHABILITATION/REINTEGRATION PLAN OF CARE"
S TIUDCDA=$G(XPDQUES("POS001")),TIUDCNM=$G(XPDQUES("POS001","B"))
I TIUDCNM="" S TIUDCNM=TIUEDCNM
S (PXRMINST,TIUFPRIV)=1,TIUFWHO="N"
S TIULVL=$S(TIUDCNM'=TIUEDCNM:"T",1:"DC")
D EXARRAY(.EXARRAY,TIULVL)
S LUVALUE(1)=EXARRAY(1),LUVALUE(2)=EXARRAY(2)
S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
I IEN=0 D BMES^XPDUTL("Reminder Exchange entry "_LUVALUE(1)_" not properly installed.") Q
S TEXT="Installing Reminder Exchange entry "_LUVALUE(1)
D BMES^XPDUTL(TEXT)
S ACTION=EXARRAY(3)
D INSTALL^PXRMEXSI(IEN,ACTION,1)
S TIUTDA=$$FIND(TIUETNM,"DOC")
I +TIUTDA'>0 D Q
. D BMES^XPDUTL("Title """_TIUETNM_"""")
. D MES^XPDUTL(" NOT PROPERLY INSTALLED.")
; If user specified TBI/POLYTRAUMA DOCUMENTS as preferred Document Class,
; attach new TBI/POLYTRAUMA DOCUMENTS Document Class to Class PROGRESS NOTES
I TIUDCNM=TIUEDCNM D I 1
. N TIUEDCDA S TIUEDCDA=$$FIND(TIUEDCNM,"DC")
. I +TIUEDCDA'>0 D BMES^XPDUTL("Document Class """_TIUEDCNM_""" NOT PROPERLY INSTALLED.") Q
. D ATTACH(TIUEDCDA,3)
; Otherwise, attach TIU/POLYTRAUMA Title to preferred Document Class
E D ATTACH(TIUTDA,TIUDCDA)
;Map new TBI/POLYTRAUMA CARE PLAN Title to Enterprise Standard Title TBI/POLYTRAUMA CARE PLAN NOTE
D MAP(TIUTDA)
Q
;
;=======================================================
FIND(TIUNM,TYPE) ; Find IEN of TBI/POLYTRAUMA Document Definition
N TIUY,POP S (POP,TIUY)=0
F S TIUY=$O(^TIU(8925.1,"B",TIUNM,TIUY)) Q:+TIUY'>0 D Q:POP
. I $P($G(^TIU(8925.1,+TIUY,0)),U,4)=TYPE S POP=1
Q TIUY
;
;=======================================================
ATTACH(TIUDA,TIUPDA) ; Attach Entry (TIUDA) to desired Parent (TIUPDA)
N ERR,IENS,FLAGS,FDA,TIUFPRIV,TIUFWHO,XQORM
S TIUFPRIV=1,TIUFWHO="N",IENS=TIUDA_","
S FLAGS="K"
S IENS="?+1,"_TIUPDA_","
S FDA(8925.14,IENS,".01")=TIUDA
D UPDATE^DIE(FLAGS,"FDA","","ERR")
; if filing error occurs, write message to install log
I $D(ERR) D Q
. D BMES^XPDUTL("Unable to Attach "_$P($G(^TIU(8925.1,TIUDA,0)),U)_" to "_$P($G(^TIU(8925.1,TIUPDA,0)),U))
. D MES^XPDUTL($G(ERR("DIERR",1,"TEXT",1)))
; Re-compile menu
K ^XUTL("XQORM",TIUPDA_";TIU(8925.1,")
S XQORM=TIUPDA_";TIU(8925.1,",XQORM(0)="" D ^XQORM
Q
;
;=======================================================
MAP(TIUDA) ; Map new TBI/POLYTRAUMA Title to Enterprise Standard Title TBI TREATMENT PLAN NOTE
N ERR,IENS,FLAGS,FDA,TIUFPRIV,TIUFWHO,TIUPROD S TIUPROD=$$PROD^XUPROD(1)
I +TIUDA'>0 D BMES^XPDUTL("TBI/POLYTRAUMA REHABILITATION/REINTEGRATION PLAN OF CARE title not installed.") Q
S TIUFPRIV=1,TIUFWHO="N",IENS=TIUDA_","
S FDA(8925.1,IENS,1501)="TBI TREATMENT PLAN NOTE"
S FDA(8925.1,IENS,1502)=$$FMTE^XLFDT($$NOW^XLFDT)
S FDA(8925.1,IENS,1503)="`"_DUZ
S FLAGS="ET"
D FILE^DIE(FLAGS,"FDA","ERR")
; if filing error occurs, write message to install log & quit
I $D(ERR) D Q
. D:TIUPROD BMES^XPDUTL("Unable to map TBI/POLYTRAUMA REHABILITATION/REINTEGRATION PLAN OF CARE title") I 1
. D:TIUPROD MES^XPDUTL(" to TBI TREATMENT PLAN NOTE. You'll have to manually map the title.")
. D:TIUPROD MES^XPDUTL(" "_$G(ERR("DIERR",1,"TEXT",1)))
; otherwise activate title
K FDA
S FDA(8925.1,IENS,".07")="ACTIVE"
S FDA(8925.1,IENS,".13")="YES"
D FILE^DIE(FLAGS,"FDA","ERR")
; if filing error occurs, write message to install log
I $D(ERR) D Q
. D:TIUPROD BMES^XPDUTL("Unable to Activate TBI/POLYTRAUMA TITLE.")
. D MES^XPDUTL($G(ERR("DIERR",1,"TEXT",1)))
; finally, check for entry in "ACL" cross-reference and if missing, call EN^DIK
I +$O(^TIU(8925.1,"ACL",3,"TBI/POLYTRAUMA REHABILITATION/REINTEGRATION PLAN OF CARE",0))'>0 D
. N DIK,DA S DIK="^TIU(8925.1,",DIK(1)=".07^ACL07",DA=TIUDA D EN^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUP246 4991 printed Oct 16, 2024@18:43:27 Page 2
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
+2 QUIT
+3 ;
+4 ;=======================================================
PRE ; Pre-install - If the Exchange File entry already exists delete it.
+1 NEW LVL
+2 FOR LVL="DC","T"
Begin DoDot:1
+3 NEW ARRAY,LUVALUE,LIST,NUM
+4 DO EXARRAY(.ARRAY,LVL)
+5 SET LUVALUE(1)=ARRAY(1)
SET LUVALUE(2)=ARRAY(2)
+6 DO FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
+7 IF '$DATA(LIST)
QUIT
+8 SET NUM=$PIECE(LIST("DILIST",0),U,1)
+9 IF NUM'=0
Begin DoDot:2
+10 NEW IND
+11 FOR IND=1:1:NUM
Begin DoDot:3
+12 NEW DA,DIK
+13 SET DIK="^PXD(811.8,"
+14 SET DA=LIST("DILIST",2,IND)
+15 DO ^DIK
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
+18 ;=======================================================
EXARRAY(ARRAY,LVL) ; List of exchange entries used by delete and install
+1 SET ARRAY(1)=$SELECT(LVL="T":"TIU*1*246 20090128 TL",1:"TIU*1*246 20090128 DC/TL")
+2 SET ARRAY(2)=$SELECT(LVL="T":"01/28/2009@17:09:58",1:"01/28/2009@17:05:57")
+3 SET ARRAY(3)="O"
+4 QUIT
+5 ;
+6 ;=======================================================
POST ; Post-install.
+1 NEW ACTION,EXARRAY,IEN,LUVALUE,PXRMINST,TEXT,TIUDC,TIUFPRIV,TIUFWHO
+2 NEW TIUDCDA,TIUDCNM,TIUTDA,TIUETNM,TIUEDCNM,TIULVL
+3 SET TIUEDCNM="TBI/POLYTRAUMA DOCUMENTS"
+4 SET TIUETNM="TBI/POLYTRAUMA REHABILITATION/REINTEGRATION PLAN OF CARE"
+5 SET TIUDCDA=$GET(XPDQUES("POS001"))
SET TIUDCNM=$GET(XPDQUES("POS001","B"))
+6 IF TIUDCNM=""
SET TIUDCNM=TIUEDCNM
+7 SET (PXRMINST,TIUFPRIV)=1
SET TIUFWHO="N"
+8 SET TIULVL=$SELECT(TIUDCNM'=TIUEDCNM:"T",1:"DC")
+9 DO EXARRAY(.EXARRAY,TIULVL)
+10 SET LUVALUE(1)=EXARRAY(1)
SET LUVALUE(2)=EXARRAY(2)
+11 SET IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
+12 IF IEN=0
DO BMES^XPDUTL("Reminder Exchange entry "_LUVALUE(1)_" not properly installed.")
QUIT
+13 SET TEXT="Installing Reminder Exchange entry "_LUVALUE(1)
+14 DO BMES^XPDUTL(TEXT)
+15 SET ACTION=EXARRAY(3)
+16 DO INSTALL^PXRMEXSI(IEN,ACTION,1)
+17 SET TIUTDA=$$FIND(TIUETNM,"DOC")
+18 IF +TIUTDA'>0
Begin DoDot:1
+19 DO BMES^XPDUTL("Title """_TIUETNM_"""")
+20 DO MES^XPDUTL(" NOT PROPERLY INSTALLED.")
End DoDot:1
QUIT
+21 ; If user specified TBI/POLYTRAUMA DOCUMENTS as preferred Document Class,
+22 ; attach new TBI/POLYTRAUMA DOCUMENTS Document Class to Class PROGRESS NOTES
+23 IF TIUDCNM=TIUEDCNM
Begin DoDot:1
+24 NEW TIUEDCDA
SET TIUEDCDA=$$FIND(TIUEDCNM,"DC")
+25 IF +TIUEDCDA'>0
DO BMES^XPDUTL("Document Class """_TIUEDCNM_""" NOT PROPERLY INSTALLED.")
QUIT
+26 DO ATTACH(TIUEDCDA,3)
End DoDot:1
IF 1
+27 ; Otherwise, attach TIU/POLYTRAUMA Title to preferred Document Class
+28 IF '$TEST
DO ATTACH(TIUTDA,TIUDCDA)
+29 ;Map new TBI/POLYTRAUMA CARE PLAN Title to Enterprise Standard Title TBI/POLYTRAUMA CARE PLAN NOTE
+30 DO MAP(TIUTDA)
+31 QUIT
+32 ;
+33 ;=======================================================
FIND(TIUNM,TYPE) ; Find IEN of TBI/POLYTRAUMA Document Definition
+1 NEW TIUY,POP
SET (POP,TIUY)=0
+2 FOR
SET TIUY=$ORDER(^TIU(8925.1,"B",TIUNM,TIUY))
if +TIUY'>0
QUIT
Begin DoDot:1
+3 IF $PIECE($GET(^TIU(8925.1,+TIUY,0)),U,4)=TYPE
SET POP=1
End DoDot:1
if POP
QUIT
+4 QUIT TIUY
+5 ;
+6 ;=======================================================
ATTACH(TIUDA,TIUPDA) ; Attach Entry (TIUDA) to desired Parent (TIUPDA)
+1 NEW ERR,IENS,FLAGS,FDA,TIUFPRIV,TIUFWHO,XQORM
+2 SET TIUFPRIV=1
SET TIUFWHO="N"
SET IENS=TIUDA_","
+3 SET FLAGS="K"
+4 SET IENS="?+1,"_TIUPDA_","
+5 SET FDA(8925.14,IENS,".01")=TIUDA
+6 DO UPDATE^DIE(FLAGS,"FDA","","ERR")
+7 ; if filing error occurs, write message to install log
+8 IF $DATA(ERR)
Begin DoDot:1
+9 DO BMES^XPDUTL("Unable to Attach "_$PIECE($GET(^TIU(8925.1,TIUDA,0)),U)_" to "_$PIECE($GET(^TIU(8925.1,TIUPDA,0)),U))
+10 DO MES^XPDUTL($GET(ERR("DIERR",1,"TEXT",1)))
End DoDot:1
QUIT
+11 ; Re-compile menu
+12 KILL ^XUTL("XQORM",TIUPDA_";TIU(8925.1,")
+13 SET XQORM=TIUPDA_";TIU(8925.1,"
SET XQORM(0)=""
DO ^XQORM
+14 QUIT
+15 ;
+16 ;=======================================================
MAP(TIUDA) ; Map new TBI/POLYTRAUMA Title to Enterprise Standard Title TBI TREATMENT PLAN NOTE
+1 NEW ERR,IENS,FLAGS,FDA,TIUFPRIV,TIUFWHO,TIUPROD
SET TIUPROD=$$PROD^XUPROD(1)
+2 IF +TIUDA'>0
DO BMES^XPDUTL("TBI/POLYTRAUMA REHABILITATION/REINTEGRATION PLAN OF CARE title not installed.")
QUIT
+3 SET TIUFPRIV=1
SET TIUFWHO="N"
SET IENS=TIUDA_","
+4 SET FDA(8925.1,IENS,1501)="TBI TREATMENT PLAN NOTE"
+5 SET FDA(8925.1,IENS,1502)=$$FMTE^XLFDT($$NOW^XLFDT)
+6 SET FDA(8925.1,IENS,1503)="`"_DUZ
+7 SET FLAGS="ET"
+8 DO FILE^DIE(FLAGS,"FDA","ERR")
+9 ; if filing error occurs, write message to install log & quit
+10 IF $DATA(ERR)
Begin DoDot:1
+11 if TIUPROD
DO BMES^XPDUTL("Unable to map TBI/POLYTRAUMA REHABILITATION/REINTEGRATION PLAN OF CARE title")
IF 1
+12 if TIUPROD
DO MES^XPDUTL(" to TBI TREATMENT PLAN NOTE. You'll have to manually map the title.")
+13 if TIUPROD
DO MES^XPDUTL(" "_$GET(ERR("DIERR",1,"TEXT",1)))
End DoDot:1
QUIT
+14 ; otherwise activate title
+15 KILL FDA
+16 SET FDA(8925.1,IENS,".07")="ACTIVE"
+17 SET FDA(8925.1,IENS,".13")="YES"
+18 DO FILE^DIE(FLAGS,"FDA","ERR")
+19 ; if filing error occurs, write message to install log
+20 IF $DATA(ERR)
Begin DoDot:1
+21 if TIUPROD
DO BMES^XPDUTL("Unable to Activate TBI/POLYTRAUMA TITLE.")
+22 DO MES^XPDUTL($GET(ERR("DIERR",1,"TEXT",1)))
End DoDot:1
QUIT
+23 ; finally, check for entry in "ACL" cross-reference and if missing, call EN^DIK
+24 IF +$ORDER(^TIU(8925.1,"ACL",3,"TBI/POLYTRAUMA REHABILITATION/REINTEGRATION PLAN OF CARE",0))'>0
Begin DoDot:1
+25 NEW DIK,DA
SET DIK="^TIU(8925.1,"
SET DIK(1)=".07^ACL07"
SET DA=TIUDA
DO EN^DIK
End DoDot:1
+26 QUIT
