- TIUCRDD ;SPFO/AJB - Create Document Definitions ;Oct 02, 2020@06:55:26
- ;;1.0;TEXT INTEGRATION UTILITIES;**331,330**;Jun 20, 1997;Build 51
- ;
- ; $$FIND1^DIC ICR#2051 UPDATE^DIE ICR#2053
- ; $$GET1^DIQ ICR#2056 $$NOW^XLFDT ICR#10103
- ; $$UP^XLFSTR ICR#10104 MES^XPDUTL ICR#10141
- Q
- CRDD(NAME,TYPE,STATUS,PARENT,STDTTL) ; create a TIU Document Definition in 8925.1
- ; NAME - "Example Title" TYPE - Class "CL", Document Class "DC", (Document) Title "DOC"
- ; STATUS - Active 11, Inactive 13 PARENT - name or IEN of desired parent 8925.1
- ; STDTTL - name or IEN of enterprise standard title 8926.1
- N TIUFPRIV S TIUFPRIV=1
- ; check NAME
- S NAME=$$UP^XLFSTR($G(NAME)) I NAME="" Q "0^NAME missing."
- I '+NAME,$A($E(NAME))<65!($A($E(NAME))>90) Q "0^NAME must not start with punctuation."
- I $L(NAME)<3!($L(NAME)>60) Q "0^NAME must be 3-60 characters"
- ; check TYPE
- S TYPE=$$UP^XLFSTR($G(TYPE))
- 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.")
- I $P(TYPE,U)=0 Q TYPE
- ; set screen
- N SCR S SCR="I $P(^(0),U,4)="_""""_TYPE_""""
- ; check NAME
- 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."
- ; check STATUS
- S STATUS=$$UP^XLFSTR($G(STATUS))
- S STATUS=$S(STATUS="ACTIVE":11,STATUS="INACTIVE":13,STATUS=11:11,STATUS=13:13,1:"0^STATUS incorrect/missing.")
- I $P(STATUS,U)=0 Q STATUS
- ; check PARENT
- S PARENT=$$UP^XLFSTR($G(PARENT)) D I '+PARENT Q PARENT
- . I PARENT="" S PARENT="0^PARENT missing." Q
- . I +PARENT S PARENT=$S($$GET1^DIQ(8925.1,PARENT,.01)'="":PARENT,1:"0^Invalid IEN for PARENT.") Q
- . S PARENT=$$LU(8925.1,PARENT,"X"),PARENT=$S(+PARENT:PARENT,1:"0^PARENT not found.")
- I $$GET1^DIQ(8925.1,PARENT_",",.07,"I")=13 S STATUS=13 ; if parent is inactive, set child inactive
- I TYPE="CL",$$GET1^DIQ(8925.1,PARENT_",",.04,"I")'="CL" Q "0^PARENT must be CL for a new Class."
- I TYPE="DC",$$GET1^DIQ(8925.1,PARENT_",",.04,"I")="DOC" Q "0^PARENT must be CL/DC for a new Document Class."
- I TYPE="DOC",$$GET1^DIQ(8925.1,PARENT_",",.04,"I")'="DC" Q "0^PARENT must be DC for a new Document Title."
- ; check STDTTL
- I TYPE="DOC" S STDTTL=$$UP^XLFSTR($G(STDTTL)) D
- . I STDTTL="" S STDTTL="0^ENTERPRISE STANDARD TITLE not sent." Q
- . I +STDTTL S STDTTL=$S($$GET1^DIQ(8926.1,STDTTL,.01)'="":STDTTL,1:"0^Invalid IEN for ENTERPRISE STANDARD TITLE.") Q
- . S STDTTL=$$LU(8926.1,STDTTL,"X"),STDTTL=$S(+STDTTL:STDTTL,1:"0^Invalid NAME for ENTERPRISE STANDARD TITLE.")
- I TYPE="DOC",'+STDTTL D
- . D MES^XPDUTL("Failed to map: "_NAME_" because "_$P(STDTTL,U,2)),MES^XPDUTL("") S STDTTL=""
- . I STATUS=11 D MES^XPDUTL("STATUS will be set to INACTIVE."),MES^XPDUTL("") S STATUS=13
- ; set owner
- N OWNER S OWNER=$$LU(8930,"CLINICAL COORDINATOR","X") Q:'+OWNER "0^CLINICAL COORDINATOR class not found."
- N DA,FDA,ERR,IEN
- S FDA(8925.1,"+1,",.01)=NAME
- S FDA(8925.1,"+1,",.03)=NAME
- S FDA(8925.1,"+1,",.04)=TYPE
- S FDA(8925.1,"+1,",.06)=OWNER
- S FDA(8925.1,"+1,",.07)=STATUS
- I TYPE="DOC" D
- . S FDA(8925.1,"+1,",1501)=$G(STDTTL)
- . S FDA(8925.1,"+1,",1502)=$$NOW^XLFDT
- . S FDA(8925.1,"+1,",1503)=DUZ
- S FDA(8925.1,"+1,",99)=$H
- D UPDATE^DIE("","FDA","IEN","ERR") S DA=IEN(1)
- D ATTACH(PARENT,DA)
- Q $G(DA,0)
- ATTACH(PARENT,CHILD) ;
- N FDA,IEN,ERR
- S FDA(8925.14,"+2,"_PARENT_",",.01)=CHILD
- S FDA(8925.14,"+2,"_PARENT_",",4)=$$GET1^DIQ(8925.1,CHILD,.01)
- D UPDATE^DIE("","FDA","IEN","ERR")
- Q
- LU(FILE,NAME,FLAGS,SCREEN,INDEXES,IENS) ;
- N DILOCKTM,DISYS
- Q $$FIND1^DIC(FILE,$G(IENS),$G(FLAGS),$G(NAME),$G(INDEXES),$G(SCREEN),"ERR")
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUCRDD 3772 printed Feb 19, 2025@00:05:58 Page 2
- 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
- +2 ;
- +3 ; $$FIND1^DIC ICR#2051 UPDATE^DIE ICR#2053
- +4 ; $$GET1^DIQ ICR#2056 $$NOW^XLFDT ICR#10103
- +5 ; $$UP^XLFSTR ICR#10104 MES^XPDUTL ICR#10141
- +6 QUIT
- 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"
- +2 ; STATUS - Active 11, Inactive 13 PARENT - name or IEN of desired parent 8925.1
- +3 ; STDTTL - name or IEN of enterprise standard title 8926.1
- +4 NEW TIUFPRIV
- SET TIUFPRIV=1
- +5 ; check NAME
- +6 SET NAME=$$UP^XLFSTR($GET(NAME))
- IF NAME=""
- QUIT "0^NAME missing."
- +7 IF '+NAME
- IF $ASCII($EXTRACT(NAME))<65!($ASCII($EXTRACT(NAME))>90)
- QUIT "0^NAME must not start with punctuation."
- +8 IF $LENGTH(NAME)<3!($LENGTH(NAME)>60)
- QUIT "0^NAME must be 3-60 characters"
- +9 ; check TYPE
- +10 SET TYPE=$$UP^XLFSTR($GET(TYPE))
- +11 SET TYPE=$SELECT(TYPE="CLASS":"CL",TYPE="DOCUMENT CLASS":"DC",TYPE="TITLE":"DOC",TYPE="CL":"CL",TYPE="DC":"DC",TYPE="DOC":"DOC",1:"0^TYPE incorrect/missing.")
- +12 IF $PIECE(TYPE,U)=0
- QUIT TYPE
- +13 ; set screen
- +14 NEW SCR
- SET SCR="I $P(^(0),U,4)="_""""_TYPE_""""
- +15 ; check NAME
- +16 IF +$$LU(8925.1,NAME,"X",SCR)
- QUIT "0^"_NAME_" "_$SELECT(TYPE="CL":"Class",TYPE="DC":"Document Class",1:"Title")_" already exists in 8925.1."
- +17 ; check STATUS
- +18 SET STATUS=$$UP^XLFSTR($GET(STATUS))
- +19 SET STATUS=$SELECT(STATUS="ACTIVE":11,STATUS="INACTIVE":13,STATUS=11:11,STATUS=13:13,1:"0^STATUS incorrect/missing.")
- +20 IF $PIECE(STATUS,U)=0
- QUIT STATUS
- +21 ; check PARENT
- +22 SET PARENT=$$UP^XLFSTR($GET(PARENT))
- Begin DoDot:1
- +23 IF PARENT=""
- SET PARENT="0^PARENT missing."
- QUIT
- +24 IF +PARENT
- SET PARENT=$SELECT($$GET1^DIQ(8925.1,PARENT,.01)'="":PARENT,1:"0^Invalid IEN for PARENT.")
- QUIT
- +25 SET PARENT=$$LU(8925.1,PARENT,"X")
- SET PARENT=$SELECT(+PARENT:PARENT,1:"0^PARENT not found.")
- End DoDot:1
- IF '+PARENT
- QUIT PARENT
- +26 ; if parent is inactive, set child inactive
- IF $$GET1^DIQ(8925.1,PARENT_",",.07,"I")=13
- SET STATUS=13
- +27 IF TYPE="CL"
- IF $$GET1^DIQ(8925.1,PARENT_",",.04,"I")'="CL"
- QUIT "0^PARENT must be CL for a new Class."
- +28 IF TYPE="DC"
- IF $$GET1^DIQ(8925.1,PARENT_",",.04,"I")="DOC"
- QUIT "0^PARENT must be CL/DC for a new Document Class."
- +29 IF TYPE="DOC"
- IF $$GET1^DIQ(8925.1,PARENT_",",.04,"I")'="DC"
- QUIT "0^PARENT must be DC for a new Document Title."
- +30 ; check STDTTL
- +31 IF TYPE="DOC"
- SET STDTTL=$$UP^XLFSTR($GET(STDTTL))
- Begin DoDot:1
- +32 IF STDTTL=""
- SET STDTTL="0^ENTERPRISE STANDARD TITLE not sent."
- QUIT
- +33 IF +STDTTL
- SET STDTTL=$SELECT($$GET1^DIQ(8926.1,STDTTL,.01)'="":STDTTL,1:"0^Invalid IEN for ENTERPRISE STANDARD TITLE.")
- QUIT
- +34 SET STDTTL=$$LU(8926.1,STDTTL,"X")
- SET STDTTL=$SELECT(+STDTTL:STDTTL,1:"0^Invalid NAME for ENTERPRISE STANDARD TITLE.")
- End DoDot:1
- +35 IF TYPE="DOC"
- IF '+STDTTL
- Begin DoDot:1
- +36 DO MES^XPDUTL("Failed to map: "_NAME_" because "_$PIECE(STDTTL,U,2))
- DO MES^XPDUTL("")
- SET STDTTL=""
- +37 IF STATUS=11
- DO MES^XPDUTL("STATUS will be set to INACTIVE.")
- DO MES^XPDUTL("")
- SET STATUS=13
- End DoDot:1
- +38 ; set owner
- +39 NEW OWNER
- SET OWNER=$$LU(8930,"CLINICAL COORDINATOR","X")
- if '+OWNER
- QUIT "0^CLINICAL COORDINATOR class not found."
- +40 NEW DA,FDA,ERR,IEN
- +41 SET FDA(8925.1,"+1,",.01)=NAME
- +42 SET FDA(8925.1,"+1,",.03)=NAME
- +43 SET FDA(8925.1,"+1,",.04)=TYPE
- +44 SET FDA(8925.1,"+1,",.06)=OWNER
- +45 SET FDA(8925.1,"+1,",.07)=STATUS
- +46 IF TYPE="DOC"
- Begin DoDot:1
- +47 SET FDA(8925.1,"+1,",1501)=$GET(STDTTL)
- +48 SET FDA(8925.1,"+1,",1502)=$$NOW^XLFDT
- +49 SET FDA(8925.1,"+1,",1503)=DUZ
- End DoDot:1
- +50 SET FDA(8925.1,"+1,",99)=$HOROLOG
- +51 DO UPDATE^DIE("","FDA","IEN","ERR")
- SET DA=IEN(1)
- +52 DO ATTACH(PARENT,DA)
- +53 QUIT $GET(DA,0)
- ATTACH(PARENT,CHILD) ;
- +1 NEW FDA,IEN,ERR
- +2 SET FDA(8925.14,"+2,"_PARENT_",",.01)=CHILD
- +3 SET FDA(8925.14,"+2,"_PARENT_",",4)=$$GET1^DIQ(8925.1,CHILD,.01)
- +4 DO UPDATE^DIE("","FDA","IEN","ERR")
- +5 QUIT
- LU(FILE,NAME,FLAGS,SCREEN,INDEXES,IENS) ;
- +1 NEW DILOCKTM,DISYS
- +2 QUIT $$FIND1^DIC(FILE,$GET(IENS),$GET(FLAGS),$GET(NAME),$GET(INDEXES),$GET(SCREEN),"ERR")