- 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 Jan 18, 2025@03:40:24 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