Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUFLF

TIUFLF.m

Go to the documentation of this file. 
  1. TIUFLF ; SLC/MAM - Library;26-Jan-2006 12:46;MGH
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**1003**;Jun 20, 1997
  1.  ;IHS/CIA/MGH Modified to display the descriptions
  1.  ;
  1. HASBOIL(FILEDA,NODE0) ;Function Returns 0, 1, 10, or 11 (like $D) if FILEDA/any descendant has Boilerplate Text, or NA if nonapplicable (neither DOC nor CO).
  1.  ; Requires FILEDA, NODE0.
  1.  N ANS,ANSONE,ANSTEN
  1.  I $P(NODE0,U,4)'="DOC"&($P(NODE0,U,4)'="CO") S ANS="NA" G HASBX
  1.  S ANSONE=+$O(^TIU(8925.1,FILEDA,"DFLT",0)) S:ANSONE ANSONE=1
  1.  S ANSTEN=$$DHASBOIL(FILEDA)
  1.  S ANS=ANSTEN_ANSONE
  1.  I ANS="00" S ANS=0
  1.  I ANS="01" S ANS=1
  1. HASBX Q ANS
  1.  ;
  1. DHASBOIL(FILEDA) ; Function Returns 1 if any descendant has Boilerplate Text.
  1.  ; Requires FILEDA.
  1.  N TIUI,IFILEDA,ANS
  1.  I '$G(FILEDA) S ANS="ERR" G DHASX
  1.  S (TIUI,ANS)=0
  1.  F  S TIUI=$O(^TIU(8925.1,FILEDA,10,TIUI)) G:'TIUI!ANS DHASX  D
  1.  . S IFILEDA=+^TIU(8925.1,FILEDA,10,TIUI,0)
  1.  . I $D(^TIU(8925.1,IFILEDA,"DFLT")) S ANS=1 Q
  1.  . S ANS=$$DHASBOIL(IFILEDA)
  1.  . Q
  1. DHASX Q ANS
  1.  ;
  1. NODE0ARR(FILEDA,NODE0,PFILEDA) ; Sets NODE0 = ^TIU(8925.1,FILEDA,0)_U_PIECE20, where
  1.  ;PIECE20= 0,1,10,11 if FILEDA/any descendant has Boilerplate text
  1.  ;(Like $D), or NA.
  1.  ; IF NODE0 IS NOT NULL, Passes back NODE0 as an array. If NODE0 is null,
  1.  ;doesn't set subscripts, writes warning.
  1.  ; When return from this call, if FILEDA is not already on the screen but taken from an item multiple, a name xfef, etc, check for NODE0="".  This will catch broken pointers to 8925.1.
  1.  ; Sets Subscript TYPE = Stnd Abbrev = ^TMP("TIUF",$J,"TYPE"_INTERNALTYPE)). See TIUFL.
  1.  ; Sets Subscripts COWNER, STATUS = Mixed case(external value);
  1.  ; Sets Subscript POWNER = external value;
  1.  ; Sets Subscript NATL= Yes, or No;
  1.  ; Sets Subscript SHARE = Yes, No, or "" for NA;
  1.  ; Sets Subscript ORPHAN = Yes, No, or "" for NA (Object);
  1.  ; Sets Subscript ITEMS = Yes, No, or "" for NA (Object);
  1.  ; Sets Subscript BOILPT = Yes if entry or descendants have Boiltxt, No, or "" for NA (Type not Doc or CO);
  1.  ; Sets Subscript INUSE = Yes, No, ?, or "" for NA (Object).
  1.  ; Requires FILEDA = file 8925.1 IFN of 8925.1 entry.
  1.  ; Optional PFILEDA = parent IFN of FILEDA. Used for Computed Field .08 In Use for EN^DIQ.
  1.  S NODE0=$G(^TIU(8925.1,FILEDA,0))
  1.  I '$D(PFILEDA) S PFILEDA=0
  1.  I PFILEDA,NODE0="" W !!," File entry "_PFILEDA_" has Nonexistent Item "_FILEDA_"; See IRM.",! D PAUSE^TIUFXHLX G NODEX
  1.  I NODE0="" W !!," ",FILEDA_" doesn't exist in the file; See IRM.",! D PAUSE^TIUFXHLX G NODEX
  1.  N DIC,DA,DR,TIUFQ,SHARE,ORPHAN,BOILPT,TYPE,ITEMS,DIQ,USED,DESC
  1.  S DIC=8925.1,DR=".04:.13",DIQ(0)="I,E",DA=FILEDA,DIQ="TIUFQ" D EN^DIQ1
  1.  S TYPE=$G(TIUFQ(8925.1,FILEDA,.04,"I")) S:TYPE="DOC" TYPE="TL"
  1.  S NODE0("TYPE")=$G(^TMP("TIUF",$J,"TYPE"_TYPE))
  1.  S NODE0("POWNER")=$G(TIUFQ(8925.1,FILEDA,.05,"E"))
  1.  S NODE0("COWNER")=$$MIXED^TIULS($G(TIUFQ(8925.1,FILEDA,.06,"E")))
  1.  S NODE0("STATUS")=$$MIXED^TIULS($G(TIUFQ(8925.1,FILEDA,.07,"E")))
  1.  S NODE0("NATL")=$$MIXED^TIULS($G(TIUFQ(8925.1,FILEDA,.13,"E")))
  1.  I NODE0("NATL")="" S NODE0("NATL")="No"
  1.  S USED=$G(TIUFQ(8925.1,FILEDA,.08,"E")),NODE0("INUSE")=$S(USED="NA":"",USED="?":"?",1:$$MIXED^TIULS(USED))
  1.  S SHARE=$G(TIUFQ(8925.1,FILEDA,.1,"E"))
  1.  S NODE0("SHARE")=$S(SHARE="YES":"Yes",SHARE="NO":"No",SHARE=""&(TYPE'="O"):"No",1:"")
  1.  S ORPHAN=$$ORPHAN^TIUFLF4(FILEDA,NODE0)
  1.  S NODE0("ORPHAN")=$S(ORPHAN="NA":"",1:$$MIXED^TIULS(ORPHAN))
  1.  S BOILPT=$$HASBOIL(FILEDA,NODE0),$P(NODE0,U,20)=BOILPT
  1.  S NODE0("BOILPT")=$S(BOILPT="NA":"",BOILPT:"Yes",1:"No")
  1.  S ITEMS=$S($O(^TIU(8925.1,FILEDA,10,0)):1,1:0)
  1.  S NODE0("ITEMS")=$S(ITEMS:"Yes",$P(NODE0,U,4)="O":"",1:"No")
  1.  ;IHS/CIA/MGH Added to display the description field
  1.  S DESC=$$HASDESC^BTIUFD(FILEDA,NODE0)
  1.  S NODE0("DESC")=$S(DESC=1:"Yes",DESC=0:"No",1:"No")
  1.  ;End changes
  1. NODEX Q
  1.  ;
  1. DESCUSED(FILEDA) ; Function returns 1 if FILEDA has
  1.  ;descendant item of Type DOC with TIU documents (file 8925 entries)
  1.  ;pointing to it; Else returns 0.
  1.  ; Assumes DDEFs cannot be reused Except SHARED Components; stops
  1.  ;check at DOC level. It is enough to check descendants down to type
  1.  ;DOC since if a component is used, its ancestor of type DOC is used.
  1.  ;Therefore reusing COMPONENTS does not present a difficulty for
  1.  ;DDEFUSED or for DESCUSED IF CHECKING FOR USE STOPS AT THE DOC LEVEL
  1.  ;AND DOES NOT CHECK COMPONENTS.
  1.  ; Requires FILEDA.
  1.  ; Requires FILEDA's node 0 to exist.
  1.  N DESCANS,TIUI,IFILEDA,ITYPE,INODE0
  1.  S (TIUI,DESCANS)=0
  1.  F  S TIUI=$O(^TIU(8925.1,FILEDA,10,TIUI)) Q:'TIUI  D  Q:DESCANS=1
  1.  . S IFILEDA=+^TIU(8925.1,FILEDA,10,TIUI,0)
  1.  . I $O(^TIU(8925,"B",IFILEDA,0)) S DESCANS=1 Q
  1.  . S INODE0=$G(^TIU(8925.1,IFILEDA,0)),ITYPE=$P(INODE0,U,4)
  1.  . I INODE0="" S DESCANS="?" Q
  1.  . I ITYPE="DOC" Q
  1.  . S DESCANS=$$DESCUSED(IFILEDA)
  1.  . Q
  1. DESCX Q DESCANS
  1.  ;
  1. DDEFUSED(FILEDA) ; Function called by 8925.1 computed field .08 USED BY DOCMTS.
  1.  ; Assumes DDEFs CANNOT be reused except for SHARED Components.
  1.  ; Returns YES if FILEDA is pointed to by 8925 docmts or components.
  1.  ;         YES if FILEDA itself is not pointed to, but descendants
  1.  ;           of Type DOC(Title) under FILEDA in the hierarchy are
  1.  ;           pointed to.
  1.  ;         NA if FILEDA has Type Object.
  1.  ;         ? if not known to be YES and FILEDA has Item w broken pointer.
  1.  ;         NO if not YES, not ?, and not NA.
  1.  ; Requires FILEDA = 8925.1 IFN of Entry.
  1.  ; Requires Node 0 of FILEDA to exist.
  1.  N DDEFUSED,NODE0,TYPE,DESCUSED
  1.  S NODE0=^TIU(8925.1,FILEDA,0),DDEFUSED=0
  1.  I $O(^TIU(8925,"B",FILEDA,0)) S DDEFUSED="YES" G DDEFX
  1.  S TYPE=$P(NODE0,U,4)
  1.  I TYPE="O" S DDEFUSED="NA" G DDEFX
  1.  I TYPE="DOC" S DDEFUSED="NO" G DDEFX
  1.  S DESCUSED=$$DESCUSED(FILEDA)
  1.  S DDEFUSED=$S(DESCUSED:"YES",DESCUSED="?":"?",1:"NO")
  1. DDEFX Q DDEFUSED
  1.  ;