- 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 Feb 19, 2025@00:09:31 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 ;;