TIUP331 ;SPFO/AJB - iMedConsent Web ;May 01, 2020@10:06:37
;;1.0;TEXT INTEGRATION UTILITIES;**331**;Jun 20, 1997;Build 6
;
; $$FIND1^DIC ICR#2051 UPDATE^DIE ICR#2053
; $$PATCH^XPDUTL ICR#10141 MES^XPDUTL ICR#10141
Q
POST ;
N CL,DC,DOC,INSTERR,SCR,TIUFPRIV S TIUFPRIV=1
; find progress notes class
S SCR="I $P(^(0),U,4)=""CL""" ; screen for the class
S CL=$$LU(8925.1,"PROGRESS NOTES","X",SCR) I '+CL D Q
. D MES^XPDUTL(""),MES^XPDUTL("Installation Error: PROGRESS NOTES Class not found")
; check document class, install if needed
S SCR="I $P(^(0),U,4)=""DC""" ; screen for the document class
S DC=$$LU(8925.1,"IMEDCONSENT WEB","X",SCR) I +DC D MES^XPDUTL("iMedConsent Web Document Class found.")
I '+DC S DC=$$CRDD^TIUCRDD("IMEDCONSENT WEB","DC",11,CL) I +DC D MES^XPDUTL("Installation of Document Class IMEDCONSENT WEB complete.")
I '+DC D Q ; failed to create document class
. D MES^XPDUTL($P(DC,U,2))
; install document titles
N DATA,I F I=1:1 S DATA=$P($T(TITLES+I),";;",2) Q:DATA="" D
. N EST,LT ; enterprise standard title, local title
. S SCR="I $P(^(0),U,4)=""DOC""" ; screen for the document title
. ; check if title already installed
. S LT=$$LU(8925.1,$P(DATA,U),"X",SCR) I +LT D MES^XPDUTL("Local title "_$P(DATA,U)_" already installed.") Q
. ; get enterprise standard title
. S EST=$$LU(8926.1,$P(DATA,U,2),"X")
. I '+EST D S EST=""
. . D MES^XPDUTL("Installation Warning: Enterprise Standard Title ["_$P(DATA,U,2)_"] not found.")
. ; install local title
. S LT=$$CRDD^TIUCRDD($P(DATA,U),"DOC",11,DC,EST) I '+LT D Q
. . D MES^XPDUTL($P(LT,U,2))
. D MES^XPDUTL("Installation of local title "_$P(DATA,U)_" complete.")
Q
LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ;
Q $$FIND1^DIC(FILE,"",$G(FLAGS),NAME,$G(INDEXES),$G(SCREEN),"ERR")
TITLES ;
;;ADMINISTRATIVE IMED^ADMINISTRATIVE NOTE
;;CONSENT CLINICAL IMED^CONSENT
;;CONSENT CLINICAL SCANNED^CONSENT
;;CONSENT-RELEASE OF INFORMATION^ADMINISTRATIVE NOTE
;;CONSENT-RESEARCH IMED^RESEARCH CONSENT
;;CONSENT-TRANSFER IMED^ADMINISTRATIVE NOTE
;;DIAGRAMS AND PICTURES IMED^DIAGRAM
;;DISCHARGE INSTRUCTIONS IMED^EDUCATION NOTE
;;FDA REMS FORM IMED^RISK ASSESSMENT SCREENING PROGRESS NOTE
;;LEAVING AGAINST MEDICAL ADVICE IMED^AMA NOTE
;;PATIENT AGREEMENT IMED^AGREEMENT
;;PATIENT EDUCATION IMED^EDUCATION NOTE
;;PATIENT INSTRUCTIONS IMED^EDUCATION NOTE
;;PATIENT SCREENING IMED^RISK ASSESSMENT SCREENING NOTE
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUP331 2494 printed Sep 23, 2025@20:19:21 Page 2
TIUP331 ;SPFO/AJB - iMedConsent Web ;May 01, 2020@10:06:37
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**331**;Jun 20, 1997;Build 6
+2 ;
+3 ; $$FIND1^DIC ICR#2051 UPDATE^DIE ICR#2053
+4 ; $$PATCH^XPDUTL ICR#10141 MES^XPDUTL ICR#10141
+5 QUIT
POST ;
+1 NEW CL,DC,DOC,INSTERR,SCR,TIUFPRIV
SET TIUFPRIV=1
+2 ; find progress notes class
+3 ; screen for the class
SET SCR="I $P(^(0),U,4)=""CL"""
+4 SET CL=$$LU(8925.1,"PROGRESS NOTES","X",SCR)
IF '+CL
Begin DoDot:1
+5 DO MES^XPDUTL("")
DO MES^XPDUTL("Installation Error: PROGRESS NOTES Class not found")
End DoDot:1
QUIT
+6 ; check document class, install if needed
+7 ; screen for the document class
SET SCR="I $P(^(0),U,4)=""DC"""
+8 SET DC=$$LU(8925.1,"IMEDCONSENT WEB","X",SCR)
IF +DC
DO MES^XPDUTL("iMedConsent Web Document Class found.")
+9 IF '+DC
SET DC=$$CRDD^TIUCRDD("IMEDCONSENT WEB","DC",11,CL)
IF +DC
DO MES^XPDUTL("Installation of Document Class IMEDCONSENT WEB complete.")
+10 ; failed to create document class
IF '+DC
Begin DoDot:1
+11 DO MES^XPDUTL($PIECE(DC,U,2))
End DoDot:1
QUIT
+12 ; install document titles
+13 NEW DATA,I
FOR I=1:1
SET DATA=$PIECE($TEXT(TITLES+I),";;",2)
if DATA=""
QUIT
Begin DoDot:1
+14 ; enterprise standard title, local title
NEW EST,LT
+15 ; screen for the document title
SET SCR="I $P(^(0),U,4)=""DOC"""
+16 ; check if title already installed
+17 SET LT=$$LU(8925.1,$PIECE(DATA,U),"X",SCR)
IF +LT
DO MES^XPDUTL("Local title "_$PIECE(DATA,U)_" already installed.")
QUIT
+18 ; get enterprise standard title
+19 SET EST=$$LU(8926.1,$PIECE(DATA,U,2),"X")
+20 IF '+EST
Begin DoDot:2
+21 DO MES^XPDUTL("Installation Warning: Enterprise Standard Title ["_$PIECE(DATA,U,2)_"] not found.")
End DoDot:2
SET EST=""
+22 ; install local title
+23 SET LT=$$CRDD^TIUCRDD($PIECE(DATA,U),"DOC",11,DC,EST)
IF '+LT
Begin DoDot:2
+24 DO MES^XPDUTL($PIECE(LT,U,2))
End DoDot:2
QUIT
+25 DO MES^XPDUTL("Installation of local title "_$PIECE(DATA,U)_" complete.")
End DoDot:1
+26 QUIT
LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ;
+1 QUIT $$FIND1^DIC(FILE,"",$GET(FLAGS),NAME,$GET(INDEXES),$GET(SCREEN),"ERR")
TITLES ;
+1 ;;ADMINISTRATIVE IMED^ADMINISTRATIVE NOTE
+2 ;;CONSENT CLINICAL IMED^CONSENT
+3 ;;CONSENT CLINICAL SCANNED^CONSENT
+4 ;;CONSENT-RELEASE OF INFORMATION^ADMINISTRATIVE NOTE
+5 ;;CONSENT-RESEARCH IMED^RESEARCH CONSENT
+6 ;;CONSENT-TRANSFER IMED^ADMINISTRATIVE NOTE
+7 ;;DIAGRAMS AND PICTURES IMED^DIAGRAM
+8 ;;DISCHARGE INSTRUCTIONS IMED^EDUCATION NOTE
+9 ;;FDA REMS FORM IMED^RISK ASSESSMENT SCREENING PROGRESS NOTE
+10 ;;LEAVING AGAINST MEDICAL ADVICE IMED^AMA NOTE
+11 ;;PATIENT AGREEMENT IMED^AGREEMENT
+12 ;;PATIENT EDUCATION IMED^EDUCATION NOTE
+13 ;;PATIENT INSTRUCTIONS IMED^EDUCATION NOTE
+14 ;;PATIENT SCREENING IMED^RISK ASSESSMENT SCREENING NOTE
+15 ;;
