TIUFLJ.m

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

 ;

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      ;