TIU330P ;SPFO/AJB - VistA Cutoff ;Mar 24, 2021@10:46:20
;;1.0;TEXT INTEGRATION UTILITIES;**330**;Jun 20, 1997;Build 51
;
; $$FIND1^DIC ICR#2051 MES^XPDUTL ICR#10141
; $$SITE^VASITE ICR#10112
Q
PRE ;
N DC,DOC,SCR,SITE,TIUFPRIV
S SITE=$$SITE^VASITE,SITE=$P(SITE,U,2),TIUFPRIV=1
; check document class entry EHRM CUTOVER
S SCR="I $P(^(0),U,4)=""DC""" ; screen for the document class
S DC=$$LU(8925.1,"EHRM CUTOVER","X",SCR) I +DC D MES^XPDUTL("EHRM CUTOVER document class found.")
; create new dc if not found
I '+DC S DC=$$CRDD^TIUCRDD("EHRM CUTOVER","DC","ACTIVE","PROGRESS NOTES") I +DC D
. D MES^XPDUTL("Installed document class EHRM CUTOVER.")
; display error message and quit
I '+DC D MES^XPDUTL($P(DC,U,2)) Q
; check document titles
S SCR="I $P(^(0),U,4)=""DOC""" ; screen for the document title
F DOC="EHRM CUTOVER ","EHRM CUTOVER REMINDERS " D
. ; set document title length to 60 just in case, attempt lookup
. S DOC=DOC_SITE,DOC=$E(DOC,1,60),DOC("IEN")=$$LU(8925.1,DOC,"X",SCR) I +DOC("IEN") D MES^XPDUTL(DOC_" title found.") Q
. S DOC("IEN")=$$CRDD^TIUCRDD(DOC,"DOC","ACTIVE","EHRM CUTOVER","CARE MANAGEMENT NOTE") I +DOC("IEN") D MES^XPDUTL("Installed title "_DOC_".") Q
. I '+DOC("IEN") D MES^XPDUTL($P(DOC("IEN"),U,2))
Q
LU(FILE,NAME,FLAGS,SCREEN,INDEXES,IENS) ;
N DILOCKTM,DISYS
Q $$FIND1^DIC(FILE,$G(IENS),$G(FLAGS),NAME,$G(INDEXES),$G(SCREEN),"ERR")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIU330P 1432 printed Dec 13, 2024@02:38:35 Page 2
TIU330P ;SPFO/AJB - VistA Cutoff ;Mar 24, 2021@10:46:20
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**330**;Jun 20, 1997;Build 51
+2 ;
+3 ; $$FIND1^DIC ICR#2051 MES^XPDUTL ICR#10141
+4 ; $$SITE^VASITE ICR#10112
+5 QUIT
PRE ;
+1 NEW DC,DOC,SCR,SITE,TIUFPRIV
+2 SET SITE=$$SITE^VASITE
SET SITE=$PIECE(SITE,U,2)
SET TIUFPRIV=1
+3 ; check document class entry EHRM CUTOVER
+4 ; screen for the document class
SET SCR="I $P(^(0),U,4)=""DC"""
+5 SET DC=$$LU(8925.1,"EHRM CUTOVER","X",SCR)
IF +DC
DO MES^XPDUTL("EHRM CUTOVER document class found.")
+6 ; create new dc if not found
+7 IF '+DC
SET DC=$$CRDD^TIUCRDD("EHRM CUTOVER","DC","ACTIVE","PROGRESS NOTES")
IF +DC
Begin DoDot:1
+8 DO MES^XPDUTL("Installed document class EHRM CUTOVER.")
End DoDot:1
+9 ; display error message and quit
+10 IF '+DC
DO MES^XPDUTL($PIECE(DC,U,2))
QUIT
+11 ; check document titles
+12 ; screen for the document title
SET SCR="I $P(^(0),U,4)=""DOC"""
+13 FOR DOC="EHRM CUTOVER ","EHRM CUTOVER REMINDERS "
Begin DoDot:1
+14 ; set document title length to 60 just in case, attempt lookup
+15 SET DOC=DOC_SITE
SET DOC=$EXTRACT(DOC,1,60)
SET DOC("IEN")=$$LU(8925.1,DOC,"X",SCR)
IF +DOC("IEN")
DO MES^XPDUTL(DOC_" title found.")
QUIT
+16 SET DOC("IEN")=$$CRDD^TIUCRDD(DOC,"DOC","ACTIVE","EHRM CUTOVER","CARE MANAGEMENT NOTE")
IF +DOC("IEN")
DO MES^XPDUTL("Installed title "_DOC_".")
QUIT
+17 IF '+DOC("IEN")
DO MES^XPDUTL($PIECE(DOC("IEN"),U,2))
End DoDot:1
+18 QUIT
LU(FILE,NAME,FLAGS,SCREEN,INDEXES,IENS) ;
+1 NEW DILOCKTM,DISYS
+2 QUIT $$FIND1^DIC(FILE,$GET(IENS),$GET(FLAGS),NAME,$GET(INDEXES),$GET(SCREEN),"ERR")
