Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUP331

TIUP331.m

Go to the documentation of this file.
  1. TIUP331 ;SPFO/AJB - iMedConsent Web ;May 01, 2020@10:06:37
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**331**;Jun 20, 1997;Build 6
  1. ;
  1. ; $$FIND1^DIC ICR#2051 UPDATE^DIE ICR#2053
  1. ; $$PATCH^XPDUTL ICR#10141 MES^XPDUTL ICR#10141
  1. Q
  1. POST ;
  1. N CL,DC,DOC,INSTERR,SCR,TIUFPRIV S TIUFPRIV=1
  1. ; find progress notes class
  1. S SCR="I $P(^(0),U,4)=""CL""" ; screen for the class
  1. S CL=$$LU(8925.1,"PROGRESS NOTES","X",SCR) I '+CL D Q
  1. . D MES^XPDUTL(""),MES^XPDUTL("Installation Error: PROGRESS NOTES Class not found")
  1. ; check document class, install if needed
  1. S SCR="I $P(^(0),U,4)=""DC""" ; screen for the document class
  1. S DC=$$LU(8925.1,"IMEDCONSENT WEB","X",SCR) I +DC D MES^XPDUTL("iMedConsent Web Document Class found.")
  1. I '+DC S DC=$$CRDD^TIUCRDD("IMEDCONSENT WEB","DC",11,CL) I +DC D MES^XPDUTL("Installation of Document Class IMEDCONSENT WEB complete.")
  1. I '+DC D Q ; failed to create document class
  1. . D MES^XPDUTL($P(DC,U,2))
  1. ; install document titles
  1. N DATA,I F I=1:1 S DATA=$P($T(TITLES+I),";;",2) Q:DATA="" D
  1. . N EST,LT ; enterprise standard title, local title
  1. . S SCR="I $P(^(0),U,4)=""DOC""" ; screen for the document title
  1. . ; check if title already installed
  1. . S LT=$$LU(8925.1,$P(DATA,U),"X",SCR) I +LT D MES^XPDUTL("Local title "_$P(DATA,U)_" already installed.") Q
  1. . ; get enterprise standard title
  1. . S EST=$$LU(8926.1,$P(DATA,U,2),"X")
  1. . I '+EST D S EST=""
  1. . . D MES^XPDUTL("Installation Warning: Enterprise Standard Title ["_$P(DATA,U,2)_"] not found.")
  1. . ; install local title
  1. . S LT=$$CRDD^TIUCRDD($P(DATA,U),"DOC",11,DC,EST) I '+LT D Q
  1. . . D MES^XPDUTL($P(LT,U,2))
  1. . D MES^XPDUTL("Installation of local title "_$P(DATA,U)_" complete.")
  1. Q
  1. LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ;
  1. Q $$FIND1^DIC(FILE,"",$G(FLAGS),NAME,$G(INDEXES),$G(SCREEN),"ERR")
  1. TITLES ;
  1. ;;ADMINISTRATIVE IMED^ADMINISTRATIVE NOTE
  1. ;;CONSENT CLINICAL IMED^CONSENT
  1. ;;CONSENT CLINICAL SCANNED^CONSENT
  1. ;;CONSENT-RELEASE OF INFORMATION^ADMINISTRATIVE NOTE
  1. ;;CONSENT-RESEARCH IMED^RESEARCH CONSENT
  1. ;;CONSENT-TRANSFER IMED^ADMINISTRATIVE NOTE
  1. ;;DIAGRAMS AND PICTURES IMED^DIAGRAM
  1. ;;DISCHARGE INSTRUCTIONS IMED^EDUCATION NOTE
  1. ;;FDA REMS FORM IMED^RISK ASSESSMENT SCREENING PROGRESS NOTE
  1. ;;LEAVING AGAINST MEDICAL ADVICE IMED^AMA NOTE
  1. ;;PATIENT AGREEMENT IMED^AGREEMENT
  1. ;;PATIENT EDUCATION IMED^EDUCATION NOTE
  1. ;;PATIENT INSTRUCTIONS IMED^EDUCATION NOTE
  1. ;;PATIENT SCREENING IMED^RISK ASSESSMENT SCREENING NOTE
  1. ;;