TIUP258 ; ISL/JER - Install HT Titles ;11/10/15 11:42
;;1.0;TEXT INTEGRATION UTILITIES;**258**;Jun 20, 1997;Build 96
;;ICR
;;2053 FILE/UPDATE^DIE, 2051 $$FIND1^DIC, 10013 EN/ENALL/ENALL2^DIK, 10103 XLFDT, 10141 B/MES^XPDUTL, 4440 XUPROD
PRE ; pre-install
D PREPARE
Q
POST ; post-install
N TIUPGNTS,TIUCONDC,TIUHTDC,TIUCLCOR ;Doc Class for PROGRESS NOTES, CONSULTS, HOME TELEHEALTH NOTES; and IEN for user class CLINCAL COORDINATOR
S TIUPGNTS=$$LU(8925.1,"PROGRESS NOTES","X","I $P(^TIU(8925.1,+Y,0),U,4)=""CL""")
S TIUCONDC=$$LU(8925.1,"CONSULTS","X","I $P(^TIU(8925.1,+Y,0),U,4)=""DC""")
S TIUCLCOR=$$LU(8930,"CLINICAL COORDINATOR","X")
D CRE8DC ;creates/update HT doc class and sets TIUHTDC=IEN
D CRE8TITL
D MAP
D REINDEX
Q
PREPARE ; Disable/Rename HT titles
N TIUDA,TIUI,TITLESTR,TIUD0,TIUDC,TIUFPRIV,TIUFWHO
S TIUFPRIV=1,TIUFWHO="N"
D BMES^XPDUTL(" Preparing HT Document Class & Titles for Update...")
S TIUI=""
;find and disable CCHT and/or HT doc classes
F TIUI=1:1 S TITLESTR=$P($T(DOCCLASS+TIUI),";",3) Q:TITLESTR="EOL" D
.S TIUDC=$P(TITLESTR,U)
.S TIUDA=$$LU(8925.1,TIUDC,"X","I $P(^TIU(8925.1,+Y,0),U,4)=""DC""")
.D:+$G(TIUDA) DISABLE(TIUDA,TIUDC)
; Rename Home Telehealth Notes DC if it exists
S TIUDA=$$LU(8925.1,"CARE COORDINATION HOME TELEHEALTH NOTES","X","I $P(^TIU(8925.1,+Y,0),U,4)=""DC""")
I +TIUDA D
. Q:+($$LU(8925.1,"HOME TELEHEALTH NOTES","X","I $P(^TIU(8925.1,+Y,0),U,4)=""DC""")) ;don't want to rename doc class if already have HOME TELEHEALTH NOTES
. N TIUREC,TIUERR
. D MES^XPDUTL(" Renaming document class CARE COORDINATION HOME TELEHEALTH NOTES")
. D MES^XPDUTL(" as HOME TELEHEALTH NOTES.")
. S TIUREC(.01)="HOME TELEHEALTH NOTES"
. D UPDATE(TIUDA,.TIUREC,.TIUERR)
. I $D(TIUERR) D Q
. . D MES^XPDUTL(" Unable to Rename CARE COORDINATION HOME TELEHEALTH NOTES.")
. . D MES^XPDUTL(" "_$G(TIUERR("DIERR",1,"TEXT",1)))
;
; Disable CCHT and/or HT Titles if member of Doc Class HOME TELEHEALTH NOTES
N TIUDCDA,TIUCONS
S TIUDCDA=$$LU(8925.1,"HOME TELEHEALTH NOTES","X","I $P(^TIU(8925.1,+Y,0),U,4)=""DC""")
S TIUCONS=$$LU(8925.1,"CONSULTS","X","I $P(^TIU(8925.1,+Y,0),U,4)=""DC""")
N TIUI,TITLESTR,TIUTTL0,TIUTTL1,TTL0DA,TTL1DA
F TIUI=1:1 S TITLESTR=$P($T(TITLES+TIUI),";",3) Q:TITLESTR="EOL" D
.S TIUTTL0=$P(TITLESTR,U) Q:TIUTTL0']""
.S TIUTTL1=$P(TITLESTR,U,2) Q:TIUTTL1']""
.S TTL0DA=$O(^TIU(8925.1,"B",TIUTTL0,""))
.S TTL1DA=$O(^TIU(8925.1,"B",TIUTTL1,""))
.I TIUTTL0["CONSULT"&($$ISA^TIULX(+$G(TTL0DA),TIUCONS)) D:$$LU(8925.1,TIUTTL0,"X","I $P(^TIU(8925.1,+Y,0),U,4)=""DOC""") DISABLE(TTL0DA,TIUTTL0)
.I TIUTTL1["CONSULT"&($$ISA^TIULX(+$G(TTL1DA),TIUCONS)) D:$$LU(8925.1,TIUTTL1,"X","I $P(^TIU(8925.1,+Y,0),U,4)=""DOC""") DISABLE(TTL1DA,TIUTTL1)
.Q:+$G(TIUDCDA)=0 ;don't attempt disable if no HT or Care Coordination doc class was found.
.I TIUTTL0'["CONSULT"&($$ISA^TIULX(+$G(TTL0DA),$G(TIUDCDA))) D:$$LU(8925.1,TIUTTL0,"X","I $P(^TIU(8925.1,+Y,0),U,4)=""DOC""") DISABLE(TTL0DA,TIUTTL0)
.I TIUTTL1'["CONSULT"&($$ISA^TIULX(+$G(TTL1DA),$G(TIUDCDA))) D:$$LU(8925.1,TIUTTL1,"X","I $P(^TIU(8925.1,+Y,0),U,4)=""DOC""") DISABLE(TTL1DA,TIUTTL1)
K TIUI
D BMES^XPDUTL("")
; Rename selected HT Titles
F TIUI=1:1 S TITLESTR=$P($T(TITLES+TIUI),";",3) Q:TITLESTR="EOL" D
. N TIUDA,TIUTTL0,TIUTTL1,TIUREC,TIUERR
. S TIUTTL0=$P(TITLESTR,U) Q:TIUTTL0']""
. S TIUDA=$$LU(8925.1,TIUTTL0,"X","I $P(^TIU(8925.1,+Y,0),U,4)=""DOC""")
. Q:+TIUDA'>0
. S TIUTTL1=$P(TITLESTR,U,2) Q:$S((TIUTTL1']""):1,(TIUTTL0=TIUTTL1):1,1:0)
. I TIUTTL1'["CONSULT" Q:$$ISA^TIULX(TIUDA,$G(TIUDCDA))=0 ;don't rename if title isn't part of correct doc class
. I TIUTTL1["CONSULT" Q:$$ISA^TIULX(TIUDA,TIUCONS)=0
. D MES^XPDUTL(" Renaming "_TIUTTL0)
. D MES^XPDUTL(" as "_TIUTTL1_".")
. S TIUREC(.01)=TIUTTL1
. D UPDATE(TIUDA,.TIUREC,.TIUERR)
. I $D(TIUERR) D Q
. . D MES^XPDUTL(" Unable to Rename "_TIUTTL0_".")
. . D MES^XPDUTL(" "_$G(TIUERR("DIERR",1,"TEXT",1)))
Q
DISABLE(TIUDA,TIUNM) ; Disable a document definition
N TIUREC,TIUERR
D MES^XPDUTL(" Inactivating "_TIUNM_".")
S TIUREC(.07)="INACTIVE"
D UPDATE(TIUDA,.TIUREC,.TIUERR)
I $D(TIUERR) D Q
. D MES^XPDUTL(" Unable to Inactivate "_TIUNM_".")
. D MES^XPDUTL(" "_$G(TIUERR("DIERR",1,"TEXT",1)))
Q
MAP ; Map HT Titles to appropriate VHA Enterprise Standard Titles
N TIUERR,TIUIENS,TIUFLAGS,TIUFDA,TIUFPRIV,TIUFWHO,TIUPROD,TIUI,TITLESTR
D BMES^XPDUTL("Attempting to map HT titles to VHA Enterprise Standard Titles...")
S TIUPROD=$$PROD^XUPROD(1),TIUFPRIV=1,TIUFWHO="N"
F TIUI=1:1 S TITLESTR=$P($T(TITLES+TIUI),";",3) Q:TITLESTR="EOL" D
. N TIUDA,TIUTTL1,TIUETTL,TIUREC,TIUERR
. S TIUTTL1=$P(TITLESTR,U,2) Q:TIUTTL1']""
. S TIUDA=$$LU(8925.1,TIUTTL1,"X","I $P(^TIU(8925.1,+Y,0),U,4)=""DOC""")
. I +TIUDA'>0 D BMES^XPDUTL(" "_TIUTTL1_" title not installed.") Q
. S TIUIENS=TIUDA_",",TIUETTL=$P(TITLESTR,U,3)
. S TIUFDA(8925.1,TIUIENS,1501)=TIUETTL
. S TIUFDA(8925.1,TIUIENS,1502)=$$FMTE^XLFDT($$NOW^XLFDT)
. S TIUFDA(8925.1,TIUIENS,1503)="`"_DUZ
. S TIUFLAGS="ET"
. D FILE^DIE(TIUFLAGS,"TIUFDA","TIUERR")
. ; if filing error occurs, write message to install log & quit
. I $D(TIUERR) D Q
. . D:TIUPROD BMES^XPDUTL(" Unable to map "_TIUTTL1_" title") I 1
. . D:TIUPROD MES^XPDUTL(" to "_TIUETTL_". You'll have to manually map the title.")
. . D:TIUPROD MES^XPDUTL(" "_$G(TIUERR("DIERR",1,"TEXT",1)))
. . K TIUFDA(8925.1,TIUIENS)
. ; otherwise activate title
. S TIUFDA(8925.1,TIUIENS,".07")="ACTIVE"
. D FILE^DIE(TIUFLAGS,"TIUFDA","TIUERR")
. ; if filing error occurs, write message to install log
. I $D(TIUERR),TIUPROD D Q
. . D BMES^XPDUTL(" Unable to Activate "_TIUTTL1_" TITLE.")
. . D MES^XPDUTL(" "_$G(TIUERR("DIERR",1,"TEXT",1)))
. . K TIUFDA(8925.1,TIUIENS)
. ; finally, check for entry in "ACL" cross-reference and if missing, call EN^DIK
. I +$O(^TIU(8925.1,"ACL",3,TIUTTL1,0))'>0 D
. . N DIK,DA S DIK="^TIU(8925.1,",DIK(1)=".07^ACL07",DA=TIUDA D EN^DIK
Q
REINDEX ; Re-index HT Entries
N DIK
D BMES^XPDUTL(" Reindexing TIU Titles")
S DIK="^TIU(8925.1,",DIK(1)=".07^AS"
D ENALL2^DIK
S DIK="^TIU(8925.1,",DIK(1)=".07^AS"
D ENALL^DIK
Q
LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ; call FileMan Finder to look up file entry
Q $$FIND1^DIC(FILE,"",$G(FLAGS),NAME,$G(INDEXES),$G(SCREEN),"MSGERR")
CRE8DC ;create HT doc class if not already on system
N TIUINMSG
S TIUHTDC=$$CREATE("HOME TELEHEALTH NOTES","","HOME TELEHEALTH NOTES","DC","11",.TIUERR)
I $D(TIUERR) D
.N TIUI
.D BMES^XPDUTL(" The following error message was returned:")
.S TIUI="" F S TIUI=$O(TIUERR("DIERR",1,"TEXT",TIUI)) Q:TIUI="" D MES^XPDUTL(" "_$G(TIUMSG("DIERR",1,"TEXT",TIUI)))
I +$G(TIUHTDC) D
.S TIUINMSG=$$INSTALL(TIUHTDC,+$G(TIUPGNTS))
.I +$G(TIUINMSG)'>0 D BMES^XPDUTL("Error adding HOME TELEHEALTH NOTES to PROGRESS NOTES")
Q
CRE8TITL ;will loop thru TITLES to Create and Install new titles
N TIUI,TITLESTR,TIUX258,TIU01,TIU04,TIU07,TIUERR,TIU4
S TIU04="DOC",TIU07=13 ;titles are activated in MAP
F TIUI=1:1 S TITLESTR=$P($T(TITLES+TIUI),";",3) Q:TITLESTR="EOL" D
.S TIU01=$P(TITLESTR,U,2),TIU4=$P(TITLESTR,U,4)
.S TIUX258=$$CREATE(TIU01,"",TIU01,TIU04,TIU07,.TIUERR)
.I $D(TIUERR) D
..N TIUI
..D BMES^XPDUTL(" The following error message was returned:")
..S TIUI="" F S TIUI=$O(TIUERR("DIERR",1,"TEXT",TIUI)) Q:TIUI="" D MES^XPDUTL(" "_$G(TIUMSG("DIERR",1,"TEXT",TIUI)))
.I +$G(TIUX258) D
..I TIU01["CONSULT" S TIUX258=$$INSTALL(+$G(TIUX258),+$G(TIUCONDC),$G(TIU4))
..E S TIUX258=$$INSTALL(+$G(TIUX258),+$G(TIUHTDC),$G(TIU4))
..D BMES^XPDUTL(TIU01_" successfully installed")
.E D BMES^XPDUTL("Error: "_TIU01_" was not added to the document class")
Q
;
CREATE(TIUNAME,TIUABB,TIUPNAME,TIUTYPE,TIUSTAT,TIUERR) ; call FileMan Updater to create file entry
;creates new entry or updates existing entry for pilot program sites; returns IEN of entry
N TIUREC,TIUDA,TIUFPRIV,TIUFWHO,TIUNATTL
S TIUNATTL=1
I $G(TIUNAME)["CONSULT" S TIUNATTL=0
S TIUFPRIV=1,TIUFWHO="N"
S TIUREC(8925.1,"?+1,",.01)=$G(TIUNAME) ;NAME
S TIUREC(8925.1,"?+1,",.02)=$G(TIUABB) ;ABBREVIATION
S:TIUNAME="HT SUMMARY OF EPISODE NOTE" TIUPNAME="HT MONTHLY MONITOR NOTE"
S TIUREC(8925.1,"?+1,",.03)=$G(TIUPNAME) ;PRINT NAME
S TIUREC(8925.1,"?+1,",.04)=$G(TIUTYPE) ;TYPE
S TIUREC(8925.1,"?+1,",.06)=$G(TIUCLCOR) ;CLASS OWNER
S TIUREC(8925.1,"?+1,",.07)=$G(TIUSTAT) ;STATUS 11=ACTIVE, 13=INACTIVE
S TIUREC(8925.1,"?+1,",.13)=$G(TIUNATTL) ;NAT'L STD 1=YES
S TIUREC(8925.1,"?+1,",3.02)=1 ;OK TO DISTR=YES
S TIUREC(8925.1,"?+1,",99)=$H ;TIMESTAMP
D UPDATE^DIE("","TIUREC","TIUDA","TIUERR")
Q +$G(TIUDA(1))
;
INSTALL(TIUDNM,TIUPRNT,TIUMNTXT) ; Install document definition
;TIUDNM - title IEN, TIUPRNT - parent IEN, TIUMNTXT - menu text
N TIU,TIUIEN,TIUMSG
S TIU(8925.14,"?+1,"_TIUPRNT_",",.01)=TIUDNM
S TIU(8925.14,"?+1,"_TIUPRNT_",",4)=$G(TIUMNTXT) ;$G b/c menu text not defined for Doc Class
D UPDATE^DIE("","TIU","TIUIEN","TIUMSG")
I $D(TIUMSG) D
. W !!,"The following error message was returned:",!!
. S TIUMSG="" F S TIUMSG=$O(TIUMSG("DIERR",1,"TEXT",TIUMSG)) Q:TIUMSG="" W TIUMSG("DIERR",1,"TEXT",TIUMSG),!
Q +$G(TIUIEN(1))
UPDATE(TIUDA,TIUREC,TIUERR) ; call FileMan Filer to update record
N TIUIENS,TIUFLAGS,TIUFDA,TIUFPRIV,TIUFWHO,TIUFI
S TIUFPRIV=1,TIUFWHO="N",TIUIENS=TIUDA_",",TIUFI=0
F S TIUFI=$O(TIUREC(TIUFI)) Q:+TIUFI'>0 D
. S TIUFDA(8925.1,TIUIENS,TIUFI)=$G(TIUREC(TIUFI))
S TIUFLAGS="ET" ;External, Transaction (all or nothing)
D FILE^DIE(TIUFLAGS,"TIUFDA","TIUERR")
Q
TITLES ; list of titles NAME YOU ARE LOOKING FOR ^ WHAT IT WILL BE RENAMED TO ^ VHA ENT STD TITLE ^ MENU TEXT
;;CCHT SCREENING CONSULT^HT SCREENING CONSULT^CARE COORDINATION HOME TELEHEALTH CONSULT^HT Screening Consult
;;CARE COORDINATION HOME TELEHEALTH SUBSEQUENT EVAL NOTE^HT INTERVENTION NOTE^CARE COORDINATION HOME TELEHEALTH FOLLOW-UP NOTE^HT Subsequent Eval
;;CARE COORDINATION HOME TELEHEALTH SUMMARY OF EPISODE NOTE^HT SUMMARY OF EPISODE NOTE^CARE COORDINATION HOME TELEHEALTH SUMMARIZATION NOTE^HT Summary Episode
;;CCHT DISCHARGE NOTE^HT DISCHARGE NOTE^CARE COORDINATION HOME TELEHEALTH DISCHARGE NOTE^HT Discharge Note
;;CCHT VIDEO VISIT NOTE^HT VIDEO VISIT NOTE^CARE COORDINATION HOME TELEHEALTH VIDEO VISIT NOTE^HT Video Visit Note
;;CCHT ASSESSMENT TREATMENT PLAN NOTE^HT ASSESSMENT TREATMENT PLAN NOTE^CARE COORDINATION HOME TELEHEALTH TREATMENT PLAN NOTE^HT Assmnt Trmnt Plan
;;CCHT CAREGIVER ASSESSMENT NOTE^HT CAREGIVER ASSESSMENT NOTE^CARE COORDINATION HOME TELEHEALTH E & M NOTE^HT Caregiver Assmnt
;;CCHT CONTINUUM OF CARE NOTE^HT CONTINUUM OF CARE NOTE^CARE COORDINATION HOME TELEHEALTH E & M NOTE^HT Continuum Care
;;CCHT NOTE^HT NOTE^CARE COORDINATION HOME TELEHEALTH NOTE^HT Note
;;CCHT PERIODIC EVALUATION NOTE^HT PERIODIC EVALUATION NOTE^CARE COORDINATION HOME TELEHEALTH REPORT^HT Periodic Eval
;;CCHT TECH EDUCATION NOTE^HT TECH EDUCATION NOTE^CARE COORDINATION HOME TELEHEALTH EDUCATION NOTE^HT Tech Education
;;CCHT TELEPHONE CASE MANAGEMENT NOTE^HT TELEPHONE CASE MANAGEMENT NOTE^CARE COORDINATION HOME TELEHEALTH NOTE^HT Case Mgmt Note
;;EOL
Q
DOCCLASS ;list of doc classes
;;CARE COORDINATION HOME TELEHEALTH NOTES^
;;HOME TELEHEALTH NOTES^HOME TELEHEALTH NOTES^DC
;;EOL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUP258 11398 printed Apr 09, 2024@21:48:46 Page 2
TIUP258 ; ISL/JER - Install HT Titles ;11/10/15 11:42
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**258**;Jun 20, 1997;Build 96
+2 ;;ICR
+3 ;;2053 FILE/UPDATE^DIE, 2051 $$FIND1^DIC, 10013 EN/ENALL/ENALL2^DIK, 10103 XLFDT, 10141 B/MES^XPDUTL, 4440 XUPROD
PRE ; pre-install
+1 DO PREPARE
+2 QUIT
POST ; post-install
+1 ;Doc Class for PROGRESS NOTES, CONSULTS, HOME TELEHEALTH NOTES; and IEN for user class CLINCAL COORDINATOR
NEW TIUPGNTS,TIUCONDC,TIUHTDC,TIUCLCOR
+2 SET TIUPGNTS=$$LU(8925.1,"PROGRESS NOTES","X","I $P(^TIU(8925.1,+Y,0),U,4)=""CL""")
+3 SET TIUCONDC=$$LU(8925.1,"CONSULTS","X","I $P(^TIU(8925.1,+Y,0),U,4)=""DC""")
+4 SET TIUCLCOR=$$LU(8930,"CLINICAL COORDINATOR","X")
+5 ;creates/update HT doc class and sets TIUHTDC=IEN
DO CRE8DC
+6 DO CRE8TITL
+7 DO MAP
+8 DO REINDEX
+9 QUIT
PREPARE ; Disable/Rename HT titles
+1 NEW TIUDA,TIUI,TITLESTR,TIUD0,TIUDC,TIUFPRIV,TIUFWHO
+2 SET TIUFPRIV=1
SET TIUFWHO="N"
+3 DO BMES^XPDUTL(" Preparing HT Document Class & Titles for Update...")
+4 SET TIUI=""
+5 ;find and disable CCHT and/or HT doc classes
+6 FOR TIUI=1:1
SET TITLESTR=$PIECE($TEXT(DOCCLASS+TIUI),";",3)
if TITLESTR="EOL"
QUIT
Begin DoDot:1
+7 SET TIUDC=$PIECE(TITLESTR,U)
+8 SET TIUDA=$$LU(8925.1,TIUDC,"X","I $P(^TIU(8925.1,+Y,0),U,4)=""DC""")
+9 if +$GET(TIUDA)
DO DISABLE(TIUDA,TIUDC)
End DoDot:1
+10 ; Rename Home Telehealth Notes DC if it exists
+11 SET TIUDA=$$LU(8925.1,"CARE COORDINATION HOME TELEHEALTH NOTES","X","I $P(^TIU(8925.1,+Y,0),U,4)=""DC""")
+12 IF +TIUDA
Begin DoDot:1
+13 ;don't want to rename doc class if already have HOME TELEHEALTH NOTES
if +($$LU(8925.1,"HOME TELEHEALTH NOTES","X","I $P(^TIU(8925.1,+Y,0),U,4)=""DC"""))
QUIT
+14 NEW TIUREC,TIUERR
+15 DO MES^XPDUTL(" Renaming document class CARE COORDINATION HOME TELEHEALTH NOTES")
+16 DO MES^XPDUTL(" as HOME TELEHEALTH NOTES.")
+17 SET TIUREC(.01)="HOME TELEHEALTH NOTES"
+18 DO UPDATE(TIUDA,.TIUREC,.TIUERR)
+19 IF $DATA(TIUERR)
Begin DoDot:2
+20 DO MES^XPDUTL(" Unable to Rename CARE COORDINATION HOME TELEHEALTH NOTES.")
+21 DO MES^XPDUTL(" "_$GET(TIUERR("DIERR",1,"TEXT",1)))
End DoDot:2
QUIT
End DoDot:1
+22 ;
+23 ; Disable CCHT and/or HT Titles if member of Doc Class HOME TELEHEALTH NOTES
+24 NEW TIUDCDA,TIUCONS
+25 SET TIUDCDA=$$LU(8925.1,"HOME TELEHEALTH NOTES","X","I $P(^TIU(8925.1,+Y,0),U,4)=""DC""")
+26 SET TIUCONS=$$LU(8925.1,"CONSULTS","X","I $P(^TIU(8925.1,+Y,0),U,4)=""DC""")
+27 NEW TIUI,TITLESTR,TIUTTL0,TIUTTL1,TTL0DA,TTL1DA
+28 FOR TIUI=1:1
SET TITLESTR=$PIECE($TEXT(TITLES+TIUI),";",3)
if TITLESTR="EOL"
QUIT
Begin DoDot:1
+29 SET TIUTTL0=$PIECE(TITLESTR,U)
if TIUTTL0']""
QUIT
+30 SET TIUTTL1=$PIECE(TITLESTR,U,2)
if TIUTTL1']""
QUIT
+31 SET TTL0DA=$ORDER(^TIU(8925.1,"B",TIUTTL0,""))
+32 SET TTL1DA=$ORDER(^TIU(8925.1,"B",TIUTTL1,""))
+33 IF TIUTTL0["CONSULT"&($$ISA^TIULX(+$GET(TTL0DA),TIUCONS))
if $$LU(8925.1,TIUTTL0,"X","I $P(^TIU(8925.1,+Y,0),U,4)=""DOC""")
DO DISABLE(TTL0DA,TIUTTL0)
+34 IF TIUTTL1["CONSULT"&($$ISA^TIULX(+$GET(TTL1DA),TIUCONS))
if $$LU(8925.1,TIUTTL1,"X","I $P(^TIU(8925.1,+Y,0),U,4)=""DOC""")
DO DISABLE(TTL1DA,TIUTTL1)
+35 ;don't attempt disable if no HT or Care Coordination doc class was found.
if +$GET(TIUDCDA)=0
QUIT
+36 IF TIUTTL0'["CONSULT"&($$ISA^TIULX(+$GET(TTL0DA),$GET(TIUDCDA)))
if $$LU(8925.1,TIUTTL0,"X","I $P(^TIU(8925.1,+Y,0),U,4)=""DOC""")
DO DISABLE(TTL0DA,TIUTTL0)
+37 IF TIUTTL1'["CONSULT"&($$ISA^TIULX(+$GET(TTL1DA),$GET(TIUDCDA)))
if $$LU(8925.1,TIUTTL1,"X","I $P(^TIU(8925.1,+Y,0),U,4)=""DOC""")
DO DISABLE(TTL1DA,TIUTTL1)
End DoDot:1
+38 KILL TIUI
+39 DO BMES^XPDUTL("")
+40 ; Rename selected HT Titles
+41 FOR TIUI=1:1
SET TITLESTR=$PIECE($TEXT(TITLES+TIUI),";",3)
if TITLESTR="EOL"
QUIT
Begin DoDot:1
+42 NEW TIUDA,TIUTTL0,TIUTTL1,TIUREC,TIUERR
+43 SET TIUTTL0=$PIECE(TITLESTR,U)
if TIUTTL0']""
QUIT
+44 SET TIUDA=$$LU(8925.1,TIUTTL0,"X","I $P(^TIU(8925.1,+Y,0),U,4)=""DOC""")
+45 if +TIUDA'>0
QUIT
+46 SET TIUTTL1=$PIECE(TITLESTR,U,2)
if $SELECT((TIUTTL1']"")
QUIT
+47 ;don't rename if title isn't part of correct doc class
IF TIUTTL1'["CONSULT"
if $$ISA^TIULX(TIUDA,$GET(TIUDCDA))=0
QUIT
+48 IF TIUTTL1["CONSULT"
if $$ISA^TIULX(TIUDA,TIUCONS)=0
QUIT
+49 DO MES^XPDUTL(" Renaming "_TIUTTL0)
+50 DO MES^XPDUTL(" as "_TIUTTL1_".")
+51 SET TIUREC(.01)=TIUTTL1
+52 DO UPDATE(TIUDA,.TIUREC,.TIUERR)
+53 IF $DATA(TIUERR)
Begin DoDot:2
+54 DO MES^XPDUTL(" Unable to Rename "_TIUTTL0_".")
+55 DO MES^XPDUTL(" "_$GET(TIUERR("DIERR",1,"TEXT",1)))
End DoDot:2
QUIT
End DoDot:1
+56 QUIT
DISABLE(TIUDA,TIUNM) ; Disable a document definition
+1 NEW TIUREC,TIUERR
+2 DO MES^XPDUTL(" Inactivating "_TIUNM_".")
+3 SET TIUREC(.07)="INACTIVE"
+4 DO UPDATE(TIUDA,.TIUREC,.TIUERR)
+5 IF $DATA(TIUERR)
Begin DoDot:1
+6 DO MES^XPDUTL(" Unable to Inactivate "_TIUNM_".")
+7 DO MES^XPDUTL(" "_$GET(TIUERR("DIERR",1,"TEXT",1)))
End DoDot:1
QUIT
+8 QUIT
MAP ; Map HT Titles to appropriate VHA Enterprise Standard Titles
+1 NEW TIUERR,TIUIENS,TIUFLAGS,TIUFDA,TIUFPRIV,TIUFWHO,TIUPROD,TIUI,TITLESTR
+2 DO BMES^XPDUTL("Attempting to map HT titles to VHA Enterprise Standard Titles...")
+3 SET TIUPROD=$$PROD^XUPROD(1)
SET TIUFPRIV=1
SET TIUFWHO="N"
+4 FOR TIUI=1:1
SET TITLESTR=$PIECE($TEXT(TITLES+TIUI),";",3)
if TITLESTR="EOL"
QUIT
Begin DoDot:1
+5 NEW TIUDA,TIUTTL1,TIUETTL,TIUREC,TIUERR
+6 SET TIUTTL1=$PIECE(TITLESTR,U,2)
if TIUTTL1']""
QUIT
+7 SET TIUDA=$$LU(8925.1,TIUTTL1,"X","I $P(^TIU(8925.1,+Y,0),U,4)=""DOC""")
+8 IF +TIUDA'>0
DO BMES^XPDUTL(" "_TIUTTL1_" title not installed.")
QUIT
+9 SET TIUIENS=TIUDA_","
SET TIUETTL=$PIECE(TITLESTR,U,3)
+10 SET TIUFDA(8925.1,TIUIENS,1501)=TIUETTL
+11 SET TIUFDA(8925.1,TIUIENS,1502)=$$FMTE^XLFDT($$NOW^XLFDT)
+12 SET TIUFDA(8925.1,TIUIENS,1503)="`"_DUZ
+13 SET TIUFLAGS="ET"
+14 DO FILE^DIE(TIUFLAGS,"TIUFDA","TIUERR")
+15 ; if filing error occurs, write message to install log & quit
+16 IF $DATA(TIUERR)
Begin DoDot:2
+17 if TIUPROD
DO BMES^XPDUTL(" Unable to map "_TIUTTL1_" title")
IF 1
+18 if TIUPROD
DO MES^XPDUTL(" to "_TIUETTL_". You'll have to manually map the title.")
+19 if TIUPROD
DO MES^XPDUTL(" "_$GET(TIUERR("DIERR",1,"TEXT",1)))
+20 KILL TIUFDA(8925.1,TIUIENS)
End DoDot:2
QUIT
+21 ; otherwise activate title
+22 SET TIUFDA(8925.1,TIUIENS,".07")="ACTIVE"
+23 DO FILE^DIE(TIUFLAGS,"TIUFDA","TIUERR")
+24 ; if filing error occurs, write message to install log
+25 IF $DATA(TIUERR)
IF TIUPROD
Begin DoDot:2
+26 DO BMES^XPDUTL(" Unable to Activate "_TIUTTL1_" TITLE.")
+27 DO MES^XPDUTL(" "_$GET(TIUERR("DIERR",1,"TEXT",1)))
+28 KILL TIUFDA(8925.1,TIUIENS)
End DoDot:2
QUIT
+29 ; finally, check for entry in "ACL" cross-reference and if missing, call EN^DIK
+30 IF +$ORDER(^TIU(8925.1,"ACL",3,TIUTTL1,0))'>0
Begin DoDot:2
+31 NEW DIK,DA
SET DIK="^TIU(8925.1,"
SET DIK(1)=".07^ACL07"
SET DA=TIUDA
DO EN^DIK
End DoDot:2
End DoDot:1
+32 QUIT
REINDEX ; Re-index HT Entries
+1 NEW DIK
+2 DO BMES^XPDUTL(" Reindexing TIU Titles")
+3 SET DIK="^TIU(8925.1,"
SET DIK(1)=".07^AS"
+4 DO ENALL2^DIK
+5 SET DIK="^TIU(8925.1,"
SET DIK(1)=".07^AS"
+6 DO ENALL^DIK
+7 QUIT
LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ; call FileMan Finder to look up file entry
+1 QUIT $$FIND1^DIC(FILE,"",$GET(FLAGS),NAME,$GET(INDEXES),$GET(SCREEN),"MSGERR")
CRE8DC ;create HT doc class if not already on system
+1 NEW TIUINMSG
+2 SET TIUHTDC=$$CREATE("HOME TELEHEALTH NOTES","","HOME TELEHEALTH NOTES","DC","11",.TIUERR)
+3 IF $DATA(TIUERR)
Begin DoDot:1
+4 NEW TIUI
+5 DO BMES^XPDUTL(" The following error message was returned:")
+6 SET TIUI=""
FOR
SET TIUI=$ORDER(TIUERR("DIERR",1,"TEXT",TIUI))
if TIUI=""
QUIT
DO MES^XPDUTL(" "_$GET(TIUMSG("DIERR",1,"TEXT",TIUI)))
End DoDot:1
+7 IF +$GET(TIUHTDC)
Begin DoDot:1
+8 SET TIUINMSG=$$INSTALL(TIUHTDC,+$GET(TIUPGNTS))
+9 IF +$GET(TIUINMSG)'>0
DO BMES^XPDUTL("Error adding HOME TELEHEALTH NOTES to PROGRESS NOTES")
End DoDot:1
+10 QUIT
CRE8TITL ;will loop thru TITLES to Create and Install new titles
+1 NEW TIUI,TITLESTR,TIUX258,TIU01,TIU04,TIU07,TIUERR,TIU4
+2 ;titles are activated in MAP
SET TIU04="DOC"
SET TIU07=13
+3 FOR TIUI=1:1
SET TITLESTR=$PIECE($TEXT(TITLES+TIUI),";",3)
if TITLESTR="EOL"
QUIT
Begin DoDot:1
+4 SET TIU01=$PIECE(TITLESTR,U,2)
SET TIU4=$PIECE(TITLESTR,U,4)
+5 SET TIUX258=$$CREATE(TIU01,"",TIU01,TIU04,TIU07,.TIUERR)
+6 IF $DATA(TIUERR)
Begin DoDot:2
+7 NEW TIUI
+8 DO BMES^XPDUTL(" The following error message was returned:")
+9 SET TIUI=""
FOR
SET TIUI=$ORDER(TIUERR("DIERR",1,"TEXT",TIUI))
if TIUI=""
QUIT
DO MES^XPDUTL(" "_$GET(TIUMSG("DIERR",1,"TEXT",TIUI)))
End DoDot:2
+10 IF +$GET(TIUX258)
Begin DoDot:2
+11 IF TIU01["CONSULT"
SET TIUX258=$$INSTALL(+$GET(TIUX258),+$GET(TIUCONDC),$GET(TIU4))
+12 IF '$TEST
SET TIUX258=$$INSTALL(+$GET(TIUX258),+$GET(TIUHTDC),$GET(TIU4))
+13 DO BMES^XPDUTL(TIU01_" successfully installed")
End DoDot:2
+14 IF '$TEST
DO BMES^XPDUTL("Error: "_TIU01_" was not added to the document class")
End DoDot:1
+15 QUIT
+16 ;
CREATE(TIUNAME,TIUABB,TIUPNAME,TIUTYPE,TIUSTAT,TIUERR) ; call FileMan Updater to create file entry
+1 ;creates new entry or updates existing entry for pilot program sites; returns IEN of entry
+2 NEW TIUREC,TIUDA,TIUFPRIV,TIUFWHO,TIUNATTL
+3 SET TIUNATTL=1
+4 IF $GET(TIUNAME)["CONSULT"
SET TIUNATTL=0
+5 SET TIUFPRIV=1
SET TIUFWHO="N"
+6 ;NAME
SET TIUREC(8925.1,"?+1,",.01)=$GET(TIUNAME)
+7 ;ABBREVIATION
SET TIUREC(8925.1,"?+1,",.02)=$GET(TIUABB)
+8 if TIUNAME="HT SUMMARY OF EPISODE NOTE"
SET TIUPNAME="HT MONTHLY MONITOR NOTE"
+9 ;PRINT NAME
SET TIUREC(8925.1,"?+1,",.03)=$GET(TIUPNAME)
+10 ;TYPE
SET TIUREC(8925.1,"?+1,",.04)=$GET(TIUTYPE)
+11 ;CLASS OWNER
SET TIUREC(8925.1,"?+1,",.06)=$GET(TIUCLCOR)
+12 ;STATUS 11=ACTIVE, 13=INACTIVE
SET TIUREC(8925.1,"?+1,",.07)=$GET(TIUSTAT)
+13 ;NAT'L STD 1=YES
SET TIUREC(8925.1,"?+1,",.13)=$GET(TIUNATTL)
+14 ;OK TO DISTR=YES
SET TIUREC(8925.1,"?+1,",3.02)=1
+15 ;TIMESTAMP
SET TIUREC(8925.1,"?+1,",99)=$HOROLOG
+16 DO UPDATE^DIE("","TIUREC","TIUDA","TIUERR")
+17 QUIT +$GET(TIUDA(1))
+18 ;
INSTALL(TIUDNM,TIUPRNT,TIUMNTXT) ; Install document definition
+1 ;TIUDNM - title IEN, TIUPRNT - parent IEN, TIUMNTXT - menu text
+2 NEW TIU,TIUIEN,TIUMSG
+3 SET TIU(8925.14,"?+1,"_TIUPRNT_",",.01)=TIUDNM
+4 ;$G b/c menu text not defined for Doc Class
SET TIU(8925.14,"?+1,"_TIUPRNT_",",4)=$GET(TIUMNTXT)
+5 DO UPDATE^DIE("","TIU","TIUIEN","TIUMSG")
+6 IF $DATA(TIUMSG)
Begin DoDot:1
+7 WRITE !!,"The following error message was returned:",!!
+8 SET TIUMSG=""
FOR
SET TIUMSG=$ORDER(TIUMSG("DIERR",1,"TEXT",TIUMSG))
if TIUMSG=""
QUIT
WRITE TIUMSG("DIERR",1,"TEXT",TIUMSG),!
End DoDot:1
+9 QUIT +$GET(TIUIEN(1))
UPDATE(TIUDA,TIUREC,TIUERR) ; call FileMan Filer to update record
+1 NEW TIUIENS,TIUFLAGS,TIUFDA,TIUFPRIV,TIUFWHO,TIUFI
+2 SET TIUFPRIV=1
SET TIUFWHO="N"
SET TIUIENS=TIUDA_","
SET TIUFI=0
+3 FOR
SET TIUFI=$ORDER(TIUREC(TIUFI))
if +TIUFI'>0
QUIT
Begin DoDot:1
+4 SET TIUFDA(8925.1,TIUIENS,TIUFI)=$GET(TIUREC(TIUFI))
End DoDot:1
+5 ;External, Transaction (all or nothing)
SET TIUFLAGS="ET"
+6 DO FILE^DIE(TIUFLAGS,"TIUFDA","TIUERR")
+7 QUIT
TITLES ; list of titles NAME YOU ARE LOOKING FOR ^ WHAT IT WILL BE RENAMED TO ^ VHA ENT STD TITLE ^ MENU TEXT
+1 ;;CCHT SCREENING CONSULT^HT SCREENING CONSULT^CARE COORDINATION HOME TELEHEALTH CONSULT^HT Screening Consult
+2 ;;CARE COORDINATION HOME TELEHEALTH SUBSEQUENT EVAL NOTE^HT INTERVENTION NOTE^CARE COORDINATION HOME TELEHEALTH FOLLOW-UP NOTE^HT Subsequent Eval
+3 ;;CARE COORDINATION HOME TELEHEALTH SUMMARY OF EPISODE NOTE^HT SUMMARY OF EPISODE NOTE^CARE COORDINATION HOME TELEHEALTH SUMMARIZATION NOTE^HT Summary Episode
+4 ;;CCHT DISCHARGE NOTE^HT DISCHARGE NOTE^CARE COORDINATION HOME TELEHEALTH DISCHARGE NOTE^HT Discharge Note
+5 ;;CCHT VIDEO VISIT NOTE^HT VIDEO VISIT NOTE^CARE COORDINATION HOME TELEHEALTH VIDEO VISIT NOTE^HT Video Visit Note
+6 ;;CCHT ASSESSMENT TREATMENT PLAN NOTE^HT ASSESSMENT TREATMENT PLAN NOTE^CARE COORDINATION HOME TELEHEALTH TREATMENT PLAN NOTE^HT Assmnt Trmnt Plan
+7 ;;CCHT CAREGIVER ASSESSMENT NOTE^HT CAREGIVER ASSESSMENT NOTE^CARE COORDINATION HOME TELEHEALTH E & M NOTE^HT Caregiver Assmnt
+8 ;;CCHT CONTINUUM OF CARE NOTE^HT CONTINUUM OF CARE NOTE^CARE COORDINATION HOME TELEHEALTH E & M NOTE^HT Continuum Care
+9 ;;CCHT NOTE^HT NOTE^CARE COORDINATION HOME TELEHEALTH NOTE^HT Note
+10 ;;CCHT PERIODIC EVALUATION NOTE^HT PERIODIC EVALUATION NOTE^CARE COORDINATION HOME TELEHEALTH REPORT^HT Periodic Eval
+11 ;;CCHT TECH EDUCATION NOTE^HT TECH EDUCATION NOTE^CARE COORDINATION HOME TELEHEALTH EDUCATION NOTE^HT Tech Education
+12 ;;CCHT TELEPHONE CASE MANAGEMENT NOTE^HT TELEPHONE CASE MANAGEMENT NOTE^CARE COORDINATION HOME TELEHEALTH NOTE^HT Case Mgmt Note
+13 ;;EOL
+14 QUIT
DOCCLASS ;list of doc classes
+1 ;;CARE COORDINATION HOME TELEHEALTH NOTES^
+2 ;;HOME TELEHEALTH NOTES^HOME TELEHEALTH NOTES^DC
+3 ;;EOL
