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

TIUCRDD.m

Go to the documentation of this file.
  1. TIUCRDD ;SPFO/AJB - Create Document Definitions ;Oct 02, 2020@06:55:26
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**331,330**;Jun 20, 1997;Build 51
  1. ;
  1. ; $$FIND1^DIC ICR#2051 UPDATE^DIE ICR#2053
  1. ; $$GET1^DIQ ICR#2056 $$NOW^XLFDT ICR#10103
  1. ; $$UP^XLFSTR ICR#10104 MES^XPDUTL ICR#10141
  1. Q
  1. CRDD(NAME,TYPE,STATUS,PARENT,STDTTL) ; create a TIU Document Definition in 8925.1
  1. ; NAME - "Example Title" TYPE - Class "CL", Document Class "DC", (Document) Title "DOC"
  1. ; STATUS - Active 11, Inactive 13 PARENT - name or IEN of desired parent 8925.1
  1. ; STDTTL - name or IEN of enterprise standard title 8926.1
  1. N TIUFPRIV S TIUFPRIV=1
  1. ; check NAME
  1. S NAME=$$UP^XLFSTR($G(NAME)) I NAME="" Q "0^NAME missing."
  1. I '+NAME,$A($E(NAME))<65!($A($E(NAME))>90) Q "0^NAME must not start with punctuation."
  1. I $L(NAME)<3!($L(NAME)>60) Q "0^NAME must be 3-60 characters"
  1. ; check TYPE
  1. S TYPE=$$UP^XLFSTR($G(TYPE))
  1. S TYPE=$S(TYPE="CLASS":"CL",TYPE="DOCUMENT CLASS":"DC",TYPE="TITLE":"DOC",TYPE="CL":"CL",TYPE="DC":"DC",TYPE="DOC":"DOC",1:"0^TYPE incorrect/missing.")
  1. I $P(TYPE,U)=0 Q TYPE
  1. ; set screen
  1. N SCR S SCR="I $P(^(0),U,4)="_""""_TYPE_""""
  1. ; check NAME
  1. I +$$LU(8925.1,NAME,"X",SCR) Q "0^"_NAME_" "_$S(TYPE="CL":"Class",TYPE="DC":"Document Class",1:"Title")_" already exists in 8925.1."
  1. ; check STATUS
  1. S STATUS=$$UP^XLFSTR($G(STATUS))
  1. S STATUS=$S(STATUS="ACTIVE":11,STATUS="INACTIVE":13,STATUS=11:11,STATUS=13:13,1:"0^STATUS incorrect/missing.")
  1. I $P(STATUS,U)=0 Q STATUS
  1. ; check PARENT
  1. S PARENT=$$UP^XLFSTR($G(PARENT)) D I '+PARENT Q PARENT
  1. . I PARENT="" S PARENT="0^PARENT missing." Q
  1. . I +PARENT S PARENT=$S($$GET1^DIQ(8925.1,PARENT,.01)'="":PARENT,1:"0^Invalid IEN for PARENT.") Q
  1. . S PARENT=$$LU(8925.1,PARENT,"X"),PARENT=$S(+PARENT:PARENT,1:"0^PARENT not found.")
  1. I $$GET1^DIQ(8925.1,PARENT_",",.07,"I")=13 S STATUS=13 ; if parent is inactive, set child inactive
  1. I TYPE="CL",$$GET1^DIQ(8925.1,PARENT_",",.04,"I")'="CL" Q "0^PARENT must be CL for a new Class."
  1. I TYPE="DC",$$GET1^DIQ(8925.1,PARENT_",",.04,"I")="DOC" Q "0^PARENT must be CL/DC for a new Document Class."
  1. I TYPE="DOC",$$GET1^DIQ(8925.1,PARENT_",",.04,"I")'="DC" Q "0^PARENT must be DC for a new Document Title."
  1. ; check STDTTL
  1. I TYPE="DOC" S STDTTL=$$UP^XLFSTR($G(STDTTL)) D
  1. . I STDTTL="" S STDTTL="0^ENTERPRISE STANDARD TITLE not sent." Q
  1. . I +STDTTL S STDTTL=$S($$GET1^DIQ(8926.1,STDTTL,.01)'="":STDTTL,1:"0^Invalid IEN for ENTERPRISE STANDARD TITLE.") Q
  1. . S STDTTL=$$LU(8926.1,STDTTL,"X"),STDTTL=$S(+STDTTL:STDTTL,1:"0^Invalid NAME for ENTERPRISE STANDARD TITLE.")
  1. I TYPE="DOC",'+STDTTL D
  1. . D MES^XPDUTL("Failed to map: "_NAME_" because "_$P(STDTTL,U,2)),MES^XPDUTL("") S STDTTL=""
  1. . I STATUS=11 D MES^XPDUTL("STATUS will be set to INACTIVE."),MES^XPDUTL("") S STATUS=13
  1. ; set owner
  1. N OWNER S OWNER=$$LU(8930,"CLINICAL COORDINATOR","X") Q:'+OWNER "0^CLINICAL COORDINATOR class not found."
  1. N DA,FDA,ERR,IEN
  1. S FDA(8925.1,"+1,",.01)=NAME
  1. S FDA(8925.1,"+1,",.03)=NAME
  1. S FDA(8925.1,"+1,",.04)=TYPE
  1. S FDA(8925.1,"+1,",.06)=OWNER
  1. S FDA(8925.1,"+1,",.07)=STATUS
  1. I TYPE="DOC" D
  1. . S FDA(8925.1,"+1,",1501)=$G(STDTTL)
  1. . S FDA(8925.1,"+1,",1502)=$$NOW^XLFDT
  1. . S FDA(8925.1,"+1,",1503)=DUZ
  1. S FDA(8925.1,"+1,",99)=$H
  1. D UPDATE^DIE("","FDA","IEN","ERR") S DA=IEN(1)
  1. D ATTACH(PARENT,DA)
  1. Q $G(DA,0)
  1. ATTACH(PARENT,CHILD) ;
  1. N FDA,IEN,ERR
  1. S FDA(8925.14,"+2,"_PARENT_",",.01)=CHILD
  1. S FDA(8925.14,"+2,"_PARENT_",",4)=$$GET1^DIQ(8925.1,CHILD,.01)
  1. D UPDATE^DIE("","FDA","IEN","ERR")
  1. Q
  1. LU(FILE,NAME,FLAGS,SCREEN,INDEXES,IENS) ;
  1. N DILOCKTM,DISYS
  1. Q $$FIND1^DIC(FILE,$G(IENS),$G(FLAGS),$G(NAME),$G(INDEXES),$G(SCREEN),"ERR")