TIUCHECK ;SLC/AJB,AGP TIU Objects and Templare Fields API;22-DEC-2009
;;1.0;TEXT INTEGRATION UTILITIES;**249,244**;Jun 20, 1997;Build 9
;
BLDOBJAR(TIUOUT,TIUIEN) ;
N TIUNODE
S TIUNODE=$G(^TIU(8925.1,TIUIEN,0))
S TIUOUT(TIUIEN,.01)=$P(TIUNODE,U),TIUOUT(TIUIEN,.04)=$P(TIUNODE,U,4)
S TIUOUT(TIUIEN,.07)=$$GETSTAT(TIUIEN)
S TIUOUT(TIUIEN,9)=$G(^TIU(8925.1,TIUIEN,9))
Q
;
CANUREMD(TIUIEN) ;
N TIUNODE,TIURESLT
S TIURESLT=0
I $$PATCH^XPDUTL("PXRM*2.0*12")=0 D Q TIURESLT
.S TIUNODE=$G(^PXRMD(801.41,TIUIEN,0))
.I $P(TIUNODE,U,4)'="R" Q
.I $P(TIUNODE,U,3)'="" Q
.S TIURESLT=1
S TIURESLT=$$ISACTDLG^PXRMDLG6(TIUIEN)
Q TIURESLT
;
FINDIEN(X) ;
; need to check both the B and C xref return -1 if name does not exist
;or if name does exist and the item is not an object.
;if item is an object returns the IEN for the object.
N DIC,Y
S DIC=8925.1,DIC(0)="FMXZ"
S DIC("S")="I $P($G(^TIU(8925.1,+Y,0)),U,4)=""O"""
D ^DIC
I +Y'>0 Q -1
Q +Y
;
GETSTAT(TIUIEN) ;
N TIUSTIEN
S TIUSTIEN=$P($G(^TIU(8925.1,TIUIEN,0)),U,7)
Q $P($G(^TIU(8925.6,TIUSTIEN,0)),U)
;
OBJBYIEN(TIUOUT,TIUIEN) ;
D BLDOBJAR(.TIUOUT,TIUIEN)
Q
;
OBJBYNAM(TIUOUT,TIUNAME) ;
N TIUIEN
S TIUIEN=$$FINDIEN(TIUNAME) I TIUIEN=-1 Q -1
D BLDOBJAR(.TIUOUT,TIUIEN)
Q TIUIEN
;
OBJSTAT(TIUNAME) ;
;Output
; -1 Object does not exist
; 0 Object is inactive
; 1 Object exist is active
;
N TIUIEN
S TIUIEN=$$FINDIEN(TIUNAME) I TIUIEN=-1 Q -1
I $$GETSTAT(TIUIEN)="INACTIVE" Q 0
Q 1
;
TEMPSTAT(TIUNAME) ;
;Output
; -1 Template Field does not exist
; 0 Template Field is inactive
; 1 Template Field exist and is active
;
I '$D(^TIU(8927.1,"B",TIUNAME)) Q -1
N TIUIEN
S TIUIEN=$O(^TIU(8927.1,"B",TIUNAME,"")) I TIUIEN'>0 Q -1
I $P($G(^TIU(8927.1,TIUIEN,0)),U,3)=1 Q 0
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUCHECK 1846 printed Oct 16, 2024@18:39:53 Page 2
TIUCHECK ;SLC/AJB,AGP TIU Objects and Templare Fields API;22-DEC-2009
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**249,244**;Jun 20, 1997;Build 9
+2 ;
BLDOBJAR(TIUOUT,TIUIEN) ;
+1 NEW TIUNODE
+2 SET TIUNODE=$GET(^TIU(8925.1,TIUIEN,0))
+3 SET TIUOUT(TIUIEN,.01)=$PIECE(TIUNODE,U)
SET TIUOUT(TIUIEN,.04)=$PIECE(TIUNODE,U,4)
+4 SET TIUOUT(TIUIEN,.07)=$$GETSTAT(TIUIEN)
+5 SET TIUOUT(TIUIEN,9)=$GET(^TIU(8925.1,TIUIEN,9))
+6 QUIT
+7 ;
CANUREMD(TIUIEN) ;
+1 NEW TIUNODE,TIURESLT
+2 SET TIURESLT=0
+3 IF $$PATCH^XPDUTL("PXRM*2.0*12")=0
Begin DoDot:1
+4 SET TIUNODE=$GET(^PXRMD(801.41,TIUIEN,0))
+5 IF $PIECE(TIUNODE,U,4)'="R"
QUIT
+6 IF $PIECE(TIUNODE,U,3)'=""
QUIT
+7 SET TIURESLT=1
End DoDot:1
QUIT TIURESLT
+8 SET TIURESLT=$$ISACTDLG^PXRMDLG6(TIUIEN)
+9 QUIT TIURESLT
+10 ;
FINDIEN(X) ;
+1 ; need to check both the B and C xref return -1 if name does not exist
+2 ;or if name does exist and the item is not an object.
+3 ;if item is an object returns the IEN for the object.
+4 NEW DIC,Y
+5 SET DIC=8925.1
SET DIC(0)="FMXZ"
+6 SET DIC("S")="I $P($G(^TIU(8925.1,+Y,0)),U,4)=""O"""
+7 DO ^DIC
+8 IF +Y'>0
QUIT -1
+9 QUIT +Y
+10 ;
GETSTAT(TIUIEN) ;
+1 NEW TIUSTIEN
+2 SET TIUSTIEN=$PIECE($GET(^TIU(8925.1,TIUIEN,0)),U,7)
+3 QUIT $PIECE($GET(^TIU(8925.6,TIUSTIEN,0)),U)
+4 ;
OBJBYIEN(TIUOUT,TIUIEN) ;
+1 DO BLDOBJAR(.TIUOUT,TIUIEN)
+2 QUIT
+3 ;
OBJBYNAM(TIUOUT,TIUNAME) ;
+1 NEW TIUIEN
+2 SET TIUIEN=$$FINDIEN(TIUNAME)
IF TIUIEN=-1
QUIT -1
+3 DO BLDOBJAR(.TIUOUT,TIUIEN)
+4 QUIT TIUIEN
+5 ;
OBJSTAT(TIUNAME) ;
+1 ;Output
+2 ; -1 Object does not exist
+3 ; 0 Object is inactive
+4 ; 1 Object exist is active
+5 ;
+6 NEW TIUIEN
+7 SET TIUIEN=$$FINDIEN(TIUNAME)
IF TIUIEN=-1
QUIT -1
+8 IF $$GETSTAT(TIUIEN)="INACTIVE"
QUIT 0
+9 QUIT 1
+10 ;
TEMPSTAT(TIUNAME) ;
+1 ;Output
+2 ; -1 Template Field does not exist
+3 ; 0 Template Field is inactive
+4 ; 1 Template Field exist and is active
+5 ;
+6 IF '$DATA(^TIU(8927.1,"B",TIUNAME))
QUIT -1
+7 NEW TIUIEN
+8 SET TIUIEN=$ORDER(^TIU(8927.1,"B",TIUNAME,""))
IF TIUIEN'>0
QUIT -1
+9 IF $PIECE($GET(^TIU(8927.1,TIUIEN,0)),U,3)=1
QUIT 0
+10 QUIT 1
