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 Apr 09, 2024@21:41:21 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")
