TIUCROBJ ;SPFO/AJB - Create Objects ;Jun 07, 2023@17:39
;;1.0;TEXT INTEGRATION UTILITIES;**341,359**;Jun 20, 1997;Build 17
;
; $$FIND1^DIC ICR#2051 UPDATE^DIE ICR#2053
; $$GET1^DIQ ICR#2056 $$UP^XLFSTR ICR#10104
; ^DIM ICR#10016
Q
; Parameter List:
; NAME object name
; ABBR abbreviation [optional], default null
; PNAME print name [optional], default NAME
; METHOD object method [optional], default null
; POWNER personal owner [optional], default null
; NSTANDARD national standard [optional], default null
;
; Basic Settings:
; CLASS OWNER set to "CLINCAL COORDINATOR", default if no personal owner
; STATUS set to ACTIVE
;
CROBJ(NAME,ABBR,PNAME,METHOD,POWNER,NSTANDARD) ; create objects
; verify name
S NAME=$$UP^XLFSTR($G(NAME)) Q:NAME="" "0^NAME missing."
Q:NAME?1P.E "0^NAME must not start with punctuation."
I $L(NAME)<3!($L(NAME)>60) Q "0^NAME must be 3-60 characters."
Q:$$CHKNAME(NAME,"B") "0^Name: "_NAME_" already exists."
; verify abbreviation
S ABBR=$$UP^XLFSTR($G(ABBR))
I ABBR'="" Q:ABBR'?2.4A "0^ABBREVIATION must be 2 to 4 letters."
I ABBR'="" Q:$$CHKNAME(ABBR,"C") "0^Abbreviation: "_ABBR_" already exists."
; verify print name
S PNAME=$$UP^XLFSTR($G(PNAME)) I PNAME="" S PNAME=NAME
I $L(PNAME)<3!($L(PNAME)>60) Q "0^PRINT NAME must be 3-60 characters."
Q:$$CHKNAME(PNAME,"D") "0^Print Name: "_PNAME_" already exists."
; verify method
I $L($G(METHOD))>245 Q "0^OBJECT METHOD must be no more than 245 characters."
N X S X=$G(METHOD) D:X'="" ^DIM Q:'$D(X) "0^Must be standard MUMPS code."
; set personal owner/class owner
N CLOWNER S CLOWNER=$$LU(8930,"CLINICAL COORDINATOR","X"),POWNER=+$G(POWNER)
I +POWNER D ; check personal owner
. I '$L($$GET1^DIQ(200,POWNER,.01)) S POWNER=0 Q
. S CLOWNER=0 ; don't set both personal and class owner
Q:'+CLOWNER&('+POWNER) "0^Class and personal owner not found."
; create the object
N TIU,TIUDA,TIUERR,TIUFPRIV S TIUFPRIV=1
S TIU(8925.1,"+1,",.01)=NAME
S:ABBR'="" TIU(8925.1,"+1,",.02)=ABBR
S TIU(8925.1,"+1,",.03)=PNAME
S TIU(8925.1,"+1,",.04)="O"
S:+POWNER TIU(8925.1,"+1,",.05)=POWNER
S:+CLOWNER TIU(8925.1,"+1,",.06)=CLOWNER
S TIU(8925.1,"+1,",.07)=11
S:+$G(NSTANDARD)=1 TIU(8925.1,"+1,",.13)=NSTANDARD
S:$G(METHOD)'="" TIU(8925.1,"+1,",9)=METHOD
S TIU(8925.1,"+1,",99)=$H
D UPDATE^DIE("","TIU","TIUDA","TIUERR")
I $D(TIUERR) D
.N TIUMESSAGE,TIULINE
.D MSG^DIALOG("AET",.TIUMESSAGE,,,"TIUERR")
.F TIULINE=1:1:TIUMESSAGE S TIUERR=$S($G(TIUERR)'="":TIUERR_" ",1:"")_TIUMESSAGE(TIULINE)
.S TIUERR=$S(TIUERR'="":"0^"_TIUERR,1:"0^Object NOT created.")
Q $S($D(TIUERR):TIUERR,1:1)
;
CHKNAME(NAME,XREF) ; check if name is in use
N ANS,TIUDA S TIUDA=0 F S TIUDA=$O(^TIU(8925.1,XREF,NAME,TIUDA)) Q:'TIUDA D
. I $D(^TIU(8925.1,"AT","O",TIUDA)) S ANS=1
Q +$G(ANS)
;
LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ;
Q $$FIND1^DIC(FILE,"",$G(FLAGS),NAME,$G(INDEXES),$G(SCREEN))
;
CRTIUHS(TIUHSOBJ,TIUSTANDARD) ; Create TIU/Health Summary Object
;PARAMETER: TIUHSOBJ - NAME field (#.01) value of entry in
; HEALTH SUMMARY OBJECTS file (#142.5)
; TIUSTANDARD - Boolean; 1 to prevent sites from editing object
; 0 to allow sites to edit object
S TIUHSOBJ=$G(TIUHSOBJ)
I TIUHSOBJ="" Q "0^No object specified"
N TIUMETHOD,TIUOBJNAME
S TIUMETHOD=$$METHOD^TIUHSOBJ(TIUHSOBJ)
I $E(TIUMETHOD,*-2,*)=",0)" Q "0^Health Summary object does not exist"
S TIUOBJNAME=$P(TIUHSOBJ," (TIU)",1)
Q $$CROBJ(TIUOBJNAME,"",TIUOBJNAME,TIUMETHOD,,+$G(TIUSTANDARD))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUCROBJ 3703 printed Apr 09, 2024@21:44:30 Page 2
TIUCROBJ ;SPFO/AJB - Create Objects ;Jun 07, 2023@17:39
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**341,359**;Jun 20, 1997;Build 17
+2 ;
+3 ; $$FIND1^DIC ICR#2051 UPDATE^DIE ICR#2053
+4 ; $$GET1^DIQ ICR#2056 $$UP^XLFSTR ICR#10104
+5 ; ^DIM ICR#10016
+6 QUIT
+7 ; Parameter List:
+8 ; NAME object name
+9 ; ABBR abbreviation [optional], default null
+10 ; PNAME print name [optional], default NAME
+11 ; METHOD object method [optional], default null
+12 ; POWNER personal owner [optional], default null
+13 ; NSTANDARD national standard [optional], default null
+14 ;
+15 ; Basic Settings:
+16 ; CLASS OWNER set to "CLINCAL COORDINATOR", default if no personal owner
+17 ; STATUS set to ACTIVE
+18 ;
CROBJ(NAME,ABBR,PNAME,METHOD,POWNER,NSTANDARD) ; create objects
+1 ; verify name
+2 SET NAME=$$UP^XLFSTR($GET(NAME))
if NAME=""
QUIT "0^NAME missing."
+3 if NAME?1P.E
QUIT "0^NAME must not start with punctuation."
+4 IF $LENGTH(NAME)<3!($LENGTH(NAME)>60)
QUIT "0^NAME must be 3-60 characters."
+5 if $$CHKNAME(NAME,"B")
QUIT "0^Name: "_NAME_" already exists."
+6 ; verify abbreviation
+7 SET ABBR=$$UP^XLFSTR($GET(ABBR))
+8 IF ABBR'=""
if ABBR'?2.4A
QUIT "0^ABBREVIATION must be 2 to 4 letters."
+9 IF ABBR'=""
if $$CHKNAME(ABBR,"C")
QUIT "0^Abbreviation: "_ABBR_" already exists."
+10 ; verify print name
+11 SET PNAME=$$UP^XLFSTR($GET(PNAME))
IF PNAME=""
SET PNAME=NAME
+12 IF $LENGTH(PNAME)<3!($LENGTH(PNAME)>60)
QUIT "0^PRINT NAME must be 3-60 characters."
+13 if $$CHKNAME(PNAME,"D")
QUIT "0^Print Name: "_PNAME_" already exists."
+14 ; verify method
+15 IF $LENGTH($GET(METHOD))>245
QUIT "0^OBJECT METHOD must be no more than 245 characters."
+16 NEW X
SET X=$GET(METHOD)
if X'=""
DO ^DIM
if '$DATA(X)
QUIT "0^Must be standard MUMPS code."
+17 ; set personal owner/class owner
+18 NEW CLOWNER
SET CLOWNER=$$LU(8930,"CLINICAL COORDINATOR","X")
SET POWNER=+$GET(POWNER)
+19 ; check personal owner
IF +POWNER
Begin DoDot:1
+20 IF '$LENGTH($$GET1^DIQ(200,POWNER,.01))
SET POWNER=0
QUIT
+21 ; don't set both personal and class owner
SET CLOWNER=0
End DoDot:1
+22 if '+CLOWNER&('+POWNER)
QUIT "0^Class and personal owner not found."
+23 ; create the object
+24 NEW TIU,TIUDA,TIUERR,TIUFPRIV
SET TIUFPRIV=1
+25 SET TIU(8925.1,"+1,",.01)=NAME
+26 if ABBR'=""
SET TIU(8925.1,"+1,",.02)=ABBR
+27 SET TIU(8925.1,"+1,",.03)=PNAME
+28 SET TIU(8925.1,"+1,",.04)="O"
+29 if +POWNER
SET TIU(8925.1,"+1,",.05)=POWNER
+30 if +CLOWNER
SET TIU(8925.1,"+1,",.06)=CLOWNER
+31 SET TIU(8925.1,"+1,",.07)=11
+32 if +$GET(NSTANDARD)=1
SET TIU(8925.1,"+1,",.13)=NSTANDARD
+33 if $GET(METHOD)'=""
SET TIU(8925.1,"+1,",9)=METHOD
+34 SET TIU(8925.1,"+1,",99)=$HOROLOG
+35 DO UPDATE^DIE("","TIU","TIUDA","TIUERR")
+36 IF $DATA(TIUERR)
Begin DoDot:1
+37 NEW TIUMESSAGE,TIULINE
+38 DO MSG^DIALOG("AET",.TIUMESSAGE,,,"TIUERR")
+39 FOR TIULINE=1:1:TIUMESSAGE
SET TIUERR=$SELECT($GET(TIUERR)'="":TIUERR_" ",1:"")_TIUMESSAGE(TIULINE)
+40 SET TIUERR=$SELECT(TIUERR'="":"0^"_TIUERR,1:"0^Object NOT created.")
End DoDot:1
+41 QUIT $SELECT($DATA(TIUERR):TIUERR,1:1)
+42 ;
CHKNAME(NAME,XREF) ; check if name is in use
+1 NEW ANS,TIUDA
SET TIUDA=0
FOR
SET TIUDA=$ORDER(^TIU(8925.1,XREF,NAME,TIUDA))
if 'TIUDA
QUIT
Begin DoDot:1
+2 IF $DATA(^TIU(8925.1,"AT","O",TIUDA))
SET ANS=1
End DoDot:1
+3 QUIT +$GET(ANS)
+4 ;
LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ;
+1 QUIT $$FIND1^DIC(FILE,"",$GET(FLAGS),NAME,$GET(INDEXES),$GET(SCREEN))
+2 ;
CRTIUHS(TIUHSOBJ,TIUSTANDARD) ; Create TIU/Health Summary Object
+1 ;PARAMETER: TIUHSOBJ - NAME field (#.01) value of entry in
+2 ; HEALTH SUMMARY OBJECTS file (#142.5)
+3 ; TIUSTANDARD - Boolean; 1 to prevent sites from editing object
+4 ; 0 to allow sites to edit object
+5 SET TIUHSOBJ=$GET(TIUHSOBJ)
+6 IF TIUHSOBJ=""
QUIT "0^No object specified"
+7 NEW TIUMETHOD,TIUOBJNAME
+8 SET TIUMETHOD=$$METHOD^TIUHSOBJ(TIUHSOBJ)
+9 IF $EXTRACT(TIUMETHOD,*-2,*)=",0)"
QUIT "0^Health Summary object does not exist"
+10 SET TIUOBJNAME=$PIECE(TIUHSOBJ," (TIU)",1)
+11 QUIT $$CROBJ(TIUOBJNAME,"",TIUOBJNAME,TIUMETHOD,,+$GET(TIUSTANDARD))
