TIUFLJ ;SLC/MAM - NOTE, WARNOBJ(NAP,OBJECTDA,NODE0), HASIT(OBJECTDA,ONODE0,FILEDA,NAP,HASIT), DHASIT(OBJECTDA,ONODE0,FILEDA,NAP,DHASIT), EMBED(OBJECTDA,ONODE0,NAP,ALLSUB), OBJUSED(FILEDA) ;;4/23/97
;;1.0;TEXT INTEGRATION UTILITIES;**12**;Jun 20, 1997
;
NOTE ; Write note re possible change in list of titles.
I $G(^TMP("TIUF3",$J,$G(TIUFELIN)+2,0))'["Object is Embedded in Title" Q
W !!,"NAME: Since objects are embedded by name, abbreviation or print name, NOT by"
W !,"file number, your edit of name, abbreviation or print name may affect which"
W !,"titles have the object embedded in them. You may want to note the list of",!,"these titles from the Detailed Display screen NOW before it changes."
D PAUSE^TIUFXHLX
Q
;
WARNOBJ(NAP,OBJECTDA,NODE0) ; Function writes warning re edit object Name, Abbrev or Print Name. Returns CONTINUE = 1 or 0.
; Needs OBJECTDA. Needs NAP = N or A or P. Needs ^TMP("TIUFEMBED,$J,OBJECTDA,"TIUFTL",NAP). Needs NODE0.
N ATTR,CONTINUE,TITLEDA,LINENO
S ATTR=$S(NAP="N":"Name",NAP="A":"Abbreviation",1:"Print Name")
S CONTINUE=1
K ^TMP("TIUFEMBED",$J,OBJECTDA) D EMBED(OBJECTDA,NODE0,NAP,0)
S TITLEDA=0 F S TITLEDA=$O(^TMP("TIUFEMBED",$J,OBJECTDA,"TIUFTL",NAP,TITLEDA)) Q:'TITLEDA Q:^TMP("TIUFEMBED",$J,OBJECTDA,"TIUFTL",NAP,TITLEDA)'="ACTIVE" D
. S LINENO=$O(^TMP("TIUF3IDX",$J,"DAF",TITLEDA,0))
. I CONTINUE S CONTINUE=0 D
. . D FULL^VALM1 S TIUFFULL=1 W !!
. . W !,"Can't edit ",$$UPPER^TIULS(ATTR),": Object ",ATTR," is embedded in the boilerplate text"
. . W !,"of the following active title(s). If you wish to edit object ",ATTR,", you"
. . W !,"must first inactivate these titles. Then, after editing the object, you will"
. . W !,"need to update the boilerplate text of these titles and then reactivate them."
. . W !,"If you wish to edit ",ATTR," please note this list NOW and save it until all"
. . W !,"titles are reactivated.",!
. W ^TMP("TIUF3",$J,LINENO,0),!
I CONTINUE D:NAP="N" NOTE G WARNX
I 'CONTINUE D PAUSE^TIUFXHLX W !!
WARNX Q CONTINUE
;
HASIT(OBJECTDA,ONODE0,FILEDA,NAP,HASIT) ; Passes back HASIT=1 if title/
;component FILEDA has object (its name or abbreviation or print name
;or any of these, depending on NAP) in it. To "Have it", Abbrev and
;Print Name must be exact, but Name can differ in case as long as
;uppercase(embedded name) = object name.
; Requires all vars to be received and already defined.
N NAME,ABBREV,PNAME,TIUFK,TIUFJ,EMBEDNM,LINE
S NAME=$P(ONODE0,U),ABBREV=$P(ONODE0,U,2),PNAME=$P(ONODE0,U,3)
S TIUFJ=0 F S TIUFJ=$O(^TIU(8925.1,FILEDA,"DFLT",TIUFJ)) Q:'TIUFJ D
. S LINE=$G(^TIU(8925.1,FILEDA,"DFLT",TIUFJ,0))
. I LINE["|" F TIUFK=2:2:$L(LINE,"|") S EMBEDNM=$P(LINE,"|",TIUFK) D
. . I EMBEDNM="" Q
. . I NAP="N"!(NAP="ANY"),$$UPPER^TIULS(EMBEDNM)=NAME S HASIT=1
. . I NAP="A"!(NAP="ANY"),EMBEDNM=ABBREV S HASIT=1
. . I NAP="P"!(NAP="ANY"),EMBEDNM=PNAME S HASIT=1
Q
;
DHASIT(OBJECTDA,ONODE0,FILEDA,NAP,DHASIT) ; Does HASIT for FILEDA descendants
N TIUFITEM,TIUFI,MISSITEM,ITENDA,IFILEDA
S MISSITEM=$$MISSITEM^TIUFLF4(FILEDA)
I MISSITEM W !!," Corrupt Database: File Entry "_FILEDA_" Has Nonexistent Item "_MISSITEM_" ; See IRM",!,"Can't tell whether or not "_FILEDA_" has object.",! D PAUSE^TIUFXHLX G DHASX
D ITEMS^TIUFLT(FILEDA)
S TIUFI=0
F S TIUFI=$O(TIUFITEM(TIUFI)) Q:'TIUFI D
. S ITENDA=$P(TIUFITEM(TIUFI),U,2)
. S IFILEDA=+$G(^TIU(8925.1,FILEDA,10,+ITENDA,0))
. D HASIT(OBJECTDA,ONODE0,IFILEDA,NAP,.DHASIT)
. D DHASIT(OBJECTDA,ONODE0,IFILEDA,NAP,.DHASIT)
DHASX Q
;
OBJUSED(FILEDA) ; Function returns 1 if FILEDA is embedded in boilerplate text of a Title or component; 1A if any of these titles is active; else 0.
N USEDANS,TITLEDA,NODE0
S NODE0=^TIU(8925.1,FILEDA,0)
K ^TMP("TIUFEMBED",$J,FILEDA) D EMBED(FILEDA,NODE0,"ANY",1)
I '$O(^TMP("TIUFEMBED",$J,FILEDA,"TIUFTL","ANY",0)),'$O(^TMP("TIUFEMBED",$J,FILEDA,"TIUFORPHAN","ANY",0)),'$O(^TMP("TIUFEMBED",$J,FILEDA,"TIUFCO","ANY",0)) S USEDANS=0 G OBJUX
S USEDANS=1,TITLEDA=0 F S TITLEDA=$O(^TMP("TIUFEMBED",$J,FILEDA,"TIUFTL","ANY",TITLEDA)) Q:'TITLEDA I ^TMP("TIUFEMBED",$J,FILEDA,"TIUFTL","ANY",TITLEDA)="ACTIVE" S USEDANS="1A" G OBJUX
OBJUX Q USEDANS
;
EMBED(OBJECTDA,ONODE0,NAP,ALLSUBS) ; Sets ^TMP("TIUFEMBED",$J,OBJECTDA,SUBSCPT,NAP,FILEDA); See top of routine.
; Sets ^TMP("TIUFEMBED",$J,OBJECTDA,"TIUFTL",NAP,FILEDA) = status of FILEDA for Titles only: ACTIVE or TEST or INACTIVE or "".
; If ALLSUBS=1, sets array for subscripts TIUFTL, TIUFCO and TIUFORPHAN. Otherwise, just sets TIUFTL.
N PARENT,FILEDA,TNODE0,STATUS,CONODE0
K ^TMP("TIUFEMBED",$J,OBJECTDA)
I '$G(ALLSUBS) S ALLSUBS=0
S FILEDA=0 F S FILEDA=$O(^TIU(8925.1,"AT","DOC",FILEDA)) Q:'FILEDA D
. S TNODE0=$G(^TIU(8925.1,FILEDA,0)) I TNODE0="" W !!,"Title ",FILEDA," from the AT cross reference does not exist; see IRM",! Q
. S (HASIT,DHASIT)=0
. D HASIT(OBJECTDA,ONODE0,FILEDA,NAP,.HASIT)
. D DHASIT(OBJECTDA,ONODE0,FILEDA,NAP,.DHASIT)
. I 'HASIT,'DHASIT Q
. I 'DHASIT S ^TMP("TIUFEMBED",$J,OBJECTDA,"TIUFCO",NAP,FILEDA)=""
. S TNODE0=^TIU(8925.1,FILEDA,0),STATUS=$$STATWORD^TIUFLF5($P(TNODE0,U,7))
. S ^TMP("TIUFEMBED",$J,OBJECTDA,"TIUFTL",NAP,FILEDA)=STATUS
I 'ALLSUBS Q
S FILEDA=0 F S FILEDA=$O(^TIU(8925.1,"AT","CO",FILEDA)) Q:'FILEDA D
. S CONODE0=$G(^TIU(8925.1,FILEDA,0)) I CONODE0="" W !!,"Component ",FILEDA," from the AT cross reference does not exist; see IRM",! Q
. I $D(^TIU(8925.1,"AD",FILEDA)) Q
. S (HASIT,DHASIT)=0
. D HASIT(OBJECTDA,ONODE0,FILEDA,NAP,.HASIT)
. D DHASIT(OBJECTDA,ONODE0,FILEDA,NAP,.DHASIT)
. I 'HASIT,'DHASIT Q
. S ^TMP("TIUFEMBED",$J,OBJECTDA,"TIUFORPHAN",NAP,FILEDA)=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFLJ 5717 printed Dec 13, 2024@02:41:12 Page 2
TIUFLJ ;SLC/MAM - NOTE, WARNOBJ(NAP,OBJECTDA,NODE0), HASIT(OBJECTDA,ONODE0,FILEDA,NAP,HASIT), DHASIT(OBJECTDA,ONODE0,FILEDA,NAP,DHASIT), EMBED(OBJECTDA,ONODE0,NAP,ALLSUB), OBJUSED(FILEDA) ;;4/23/97
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**12**;Jun 20, 1997
+2 ;
NOTE ; Write note re possible change in list of titles.
+1 IF $GET(^TMP("TIUF3",$JOB,$GET(TIUFELIN)+2,0))'["Object is Embedded in Title"
QUIT
+2 WRITE !!,"NAME: Since objects are embedded by name, abbreviation or print name, NOT by"
+3 WRITE !,"file number, your edit of name, abbreviation or print name may affect which"
+4 WRITE !,"titles have the object embedded in them. You may want to note the list of",!,"these titles from the Detailed Display screen NOW before it changes."
+5 DO PAUSE^TIUFXHLX
+6 QUIT
+7 ;
WARNOBJ(NAP,OBJECTDA,NODE0) ; Function writes warning re edit object Name, Abbrev or Print Name. Returns CONTINUE = 1 or 0.
+1 ; Needs OBJECTDA. Needs NAP = N or A or P. Needs ^TMP("TIUFEMBED,$J,OBJECTDA,"TIUFTL",NAP). Needs NODE0.
+2 NEW ATTR,CONTINUE,TITLEDA,LINENO
+3 SET ATTR=$SELECT(NAP="N":"Name",NAP="A":"Abbreviation",1:"Print Name")
+4 SET CONTINUE=1
+5 KILL ^TMP("TIUFEMBED",$JOB,OBJECTDA)
DO EMBED(OBJECTDA,NODE0,NAP,0)
+6 SET TITLEDA=0
FOR
SET TITLEDA=$ORDER(^TMP("TIUFEMBED",$JOB,OBJECTDA,"TIUFTL",NAP,TITLEDA))
if 'TITLEDA
QUIT
if ^TMP("TIUFEMBED",$JOB,OBJECTDA,"TIUFTL",NAP,TITLEDA)'="ACTIVE"
QUIT
Begin DoDot:1
+7 SET LINENO=$ORDER(^TMP("TIUF3IDX",$JOB,"DAF",TITLEDA,0))
+8 IF CONTINUE
SET CONTINUE=0
Begin DoDot:2
+9 DO FULL^VALM1
SET TIUFFULL=1
WRITE !!
+10 WRITE !,"Can't edit ",$$UPPER^TIULS(ATTR),": Object ",ATTR," is embedded in the boilerplate text"
+11 WRITE !,"of the following active title(s). If you wish to edit object ",ATTR,", you"
+12 WRITE !,"must first inactivate these titles. Then, after editing the object, you will"
+13 WRITE !,"need to update the boilerplate text of these titles and then reactivate them."
+14 WRITE !,"If you wish to edit ",ATTR," please note this list NOW and save it until all"
+15 WRITE !,"titles are reactivated.",!
End DoDot:2
+16 WRITE ^TMP("TIUF3",$JOB,LINENO,0),!
End DoDot:1
+17 IF CONTINUE
if NAP="N"
DO NOTE
GOTO WARNX
+18 IF 'CONTINUE
DO PAUSE^TIUFXHLX
WRITE !!
WARNX QUIT CONTINUE
+1 ;
HASIT(OBJECTDA,ONODE0,FILEDA,NAP,HASIT) ; Passes back HASIT=1 if title/
+1 ;component FILEDA has object (its name or abbreviation or print name
+2 ;or any of these, depending on NAP) in it. To "Have it", Abbrev and
+3 ;Print Name must be exact, but Name can differ in case as long as
+4 ;uppercase(embedded name) = object name.
+5 ; Requires all vars to be received and already defined.
+6 NEW NAME,ABBREV,PNAME,TIUFK,TIUFJ,EMBEDNM,LINE
+7 SET NAME=$PIECE(ONODE0,U)
SET ABBREV=$PIECE(ONODE0,U,2)
SET PNAME=$PIECE(ONODE0,U,3)
+8 SET TIUFJ=0
FOR
SET TIUFJ=$ORDER(^TIU(8925.1,FILEDA,"DFLT",TIUFJ))
if 'TIUFJ
QUIT
Begin DoDot:1
+9 SET LINE=$GET(^TIU(8925.1,FILEDA,"DFLT",TIUFJ,0))
+10 IF LINE["|"
FOR TIUFK=2:2:$LENGTH(LINE,"|")
SET EMBEDNM=$PIECE(LINE,"|",TIUFK)
Begin DoDot:2
+11 IF EMBEDNM=""
QUIT
+12 IF NAP="N"!(NAP="ANY")
IF $$UPPER^TIULS(EMBEDNM)=NAME
SET HASIT=1
+13 IF NAP="A"!(NAP="ANY")
IF EMBEDNM=ABBREV
SET HASIT=1
+14 IF NAP="P"!(NAP="ANY")
IF EMBEDNM=PNAME
SET HASIT=1
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
DHASIT(OBJECTDA,ONODE0,FILEDA,NAP,DHASIT) ; Does HASIT for FILEDA descendants
+1 NEW TIUFITEM,TIUFI,MISSITEM,ITENDA,IFILEDA
+2 SET MISSITEM=$$MISSITEM^TIUFLF4(FILEDA)
+3 IF MISSITEM
WRITE !!," Corrupt Database: File Entry "_FILEDA_" Has Nonexistent Item "_MISSITEM_" ; See IRM",!,"Can't tell whether or not "_FILEDA_" has object.",!
DO PAUSE^TIUFXHLX
GOTO DHASX
+4 DO ITEMS^TIUFLT(FILEDA)
+5 SET TIUFI=0
+6 FOR
SET TIUFI=$ORDER(TIUFITEM(TIUFI))
if 'TIUFI
QUIT
Begin DoDot:1
+7 SET ITENDA=$PIECE(TIUFITEM(TIUFI),U,2)
+8 SET IFILEDA=+$GET(^TIU(8925.1,FILEDA,10,+ITENDA,0))
+9 DO HASIT(OBJECTDA,ONODE0,IFILEDA,NAP,.DHASIT)
+10 DO DHASIT(OBJECTDA,ONODE0,IFILEDA,NAP,.DHASIT)
End DoDot:1
DHASX QUIT
+1 ;
OBJUSED(FILEDA) ; Function returns 1 if FILEDA is embedded in boilerplate text of a Title or component; 1A if any of these titles is active; else 0.
+1 NEW USEDANS,TITLEDA,NODE0
+2 SET NODE0=^TIU(8925.1,FILEDA,0)
+3 KILL ^TMP("TIUFEMBED",$JOB,FILEDA)
DO EMBED(FILEDA,NODE0,"ANY",1)
+4 IF '$ORDER(^TMP("TIUFEMBED",$JOB,FILEDA,"TIUFTL","ANY",0))
IF '$ORDER(^TMP("TIUFEMBED",$JOB,FILEDA,"TIUFORPHAN","ANY",0))
IF '$ORDER(^TMP("TIUFEMBED",$JOB,FILEDA,"TIUFCO","ANY",0))
SET USEDANS=0
GOTO OBJUX
+5 SET USEDANS=1
SET TITLEDA=0
FOR
SET TITLEDA=$ORDER(^TMP("TIUFEMBED",$JOB,FILEDA,"TIUFTL","ANY",TITLEDA))
if 'TITLEDA
QUIT
IF ^TMP("TIUFEMBED",$JOB,FILEDA,"TIUFTL","ANY",TITLEDA)="ACTIVE"
SET USEDANS="1A"
GOTO OBJUX
OBJUX QUIT USEDANS
+1 ;
EMBED(OBJECTDA,ONODE0,NAP,ALLSUBS) ; Sets ^TMP("TIUFEMBED",$J,OBJECTDA,SUBSCPT,NAP,FILEDA); See top of routine.
+1 ; Sets ^TMP("TIUFEMBED",$J,OBJECTDA,"TIUFTL",NAP,FILEDA) = status of FILEDA for Titles only: ACTIVE or TEST or INACTIVE or "".
+2 ; If ALLSUBS=1, sets array for subscripts TIUFTL, TIUFCO and TIUFORPHAN. Otherwise, just sets TIUFTL.
+3 NEW PARENT,FILEDA,TNODE0,STATUS,CONODE0
+4 KILL ^TMP("TIUFEMBED",$JOB,OBJECTDA)
+5 IF '$GET(ALLSUBS)
SET ALLSUBS=0
+6 SET FILEDA=0
FOR
SET FILEDA=$ORDER(^TIU(8925.1,"AT","DOC",FILEDA))
if 'FILEDA
QUIT
Begin DoDot:1
+7 SET TNODE0=$GET(^TIU(8925.1,FILEDA,0))
IF TNODE0=""
WRITE !!,"Title ",FILEDA," from the AT cross reference does not exist; see IRM",!
QUIT
+8 SET (HASIT,DHASIT)=0
+9 DO HASIT(OBJECTDA,ONODE0,FILEDA,NAP,.HASIT)
+10 DO DHASIT(OBJECTDA,ONODE0,FILEDA,NAP,.DHASIT)
+11 IF 'HASIT
IF 'DHASIT
QUIT
+12 IF 'DHASIT
SET ^TMP("TIUFEMBED",$JOB,OBJECTDA,"TIUFCO",NAP,FILEDA)=""
+13 SET TNODE0=^TIU(8925.1,FILEDA,0)
SET STATUS=$$STATWORD^TIUFLF5($PIECE(TNODE0,U,7))
+14 SET ^TMP("TIUFEMBED",$JOB,OBJECTDA,"TIUFTL",NAP,FILEDA)=STATUS
End DoDot:1
+15 IF 'ALLSUBS
QUIT
+16 SET FILEDA=0
FOR
SET FILEDA=$ORDER(^TIU(8925.1,"AT","CO",FILEDA))
if 'FILEDA
QUIT
Begin DoDot:1
+17 SET CONODE0=$GET(^TIU(8925.1,FILEDA,0))
IF CONODE0=""
WRITE !!,"Component ",FILEDA," from the AT cross reference does not exist; see IRM",!
QUIT
+18 IF $DATA(^TIU(8925.1,"AD",FILEDA))
QUIT
+19 SET (HASIT,DHASIT)=0
+20 DO HASIT(OBJECTDA,ONODE0,FILEDA,NAP,.HASIT)
+21 DO DHASIT(OBJECTDA,ONODE0,FILEDA,NAP,.DHASIT)
+22 IF 'HASIT
IF 'DHASIT
QUIT
+23 SET ^TMP("TIUFEMBED",$JOB,OBJECTDA,"TIUFORPHAN",NAP,FILEDA)=""
End DoDot:1
+24 QUIT
+25 ;
