source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFLJ.m@ 1556

Last change on this file since 1556 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.5 KB
Line 
1TIUFLJ ;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
2 ;;1.0;TEXT INTEGRATION UTILITIES;**12**;Jun 20, 1997
3 ;
4NOTE ; Write note re possible change in list of titles.
5 I $G(^TMP("TIUF3",$J,$G(TIUFELIN)+2,0))'["Object is Embedded in Title" Q
6 W !!,"NAME: Since objects are embedded by name, abbreviation or print name, NOT by"
7 W !,"file number, your edit of name, abbreviation or print name may affect which"
8 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."
9 D PAUSE^TIUFXHLX
10 Q
11 ;
12WARNOBJ(NAP,OBJECTDA,NODE0) ; Function writes warning re edit object Name, Abbrev or Print Name. Returns CONTINUE = 1 or 0.
13 ; Needs OBJECTDA. Needs NAP = N or A or P. Needs ^TMP("TIUFEMBED,$J,OBJECTDA,"TIUFTL",NAP). Needs NODE0.
14 N ATTR,CONTINUE,TITLEDA,LINENO
15 S ATTR=$S(NAP="N":"Name",NAP="A":"Abbreviation",1:"Print Name")
16 S CONTINUE=1
17 K ^TMP("TIUFEMBED",$J,OBJECTDA) D EMBED(OBJECTDA,NODE0,NAP,0)
18 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
19 . S LINENO=$O(^TMP("TIUF3IDX",$J,"DAF",TITLEDA,0))
20 . I CONTINUE S CONTINUE=0 D
21 . . D FULL^VALM1 S TIUFFULL=1 W !!
22 . . W !,"Can't edit ",$$UPPER^TIULS(ATTR),": Object ",ATTR," is embedded in the boilerplate text"
23 . . W !,"of the following active title(s). If you wish to edit object ",ATTR,", you"
24 . . W !,"must first inactivate these titles. Then, after editing the object, you will"
25 . . W !,"need to update the boilerplate text of these titles and then reactivate them."
26 . . W !,"If you wish to edit ",ATTR," please note this list NOW and save it until all"
27 . . W !,"titles are reactivated.",!
28 . W ^TMP("TIUF3",$J,LINENO,0),!
29 I CONTINUE D:NAP="N" NOTE G WARNX
30 I 'CONTINUE D PAUSE^TIUFXHLX W !!
31WARNX Q CONTINUE
32 ;
33HASIT(OBJECTDA,ONODE0,FILEDA,NAP,HASIT) ; Passes back HASIT=1 if title/
34 ;component FILEDA has object (its name or abbreviation or print name
35 ;or any of these, depending on NAP) in it. To "Have it", Abbrev and
36 ;Print Name must be exact, but Name can differ in case as long as
37 ;uppercase(embedded name) = object name.
38 ; Requires all vars to be received and already defined.
39 N NAME,ABBREV,PNAME,TIUFK,TIUFJ,EMBEDNM,LINE
40 S NAME=$P(ONODE0,U),ABBREV=$P(ONODE0,U,2),PNAME=$P(ONODE0,U,3)
41 S TIUFJ=0 F S TIUFJ=$O(^TIU(8925.1,FILEDA,"DFLT",TIUFJ)) Q:'TIUFJ D
42 . S LINE=$G(^TIU(8925.1,FILEDA,"DFLT",TIUFJ,0))
43 . I LINE["|" F TIUFK=2:2:$L(LINE,"|") S EMBEDNM=$P(LINE,"|",TIUFK) D
44 . . I EMBEDNM="" Q
45 . . I NAP="N"!(NAP="ANY"),$$UPPER^TIULS(EMBEDNM)=NAME S HASIT=1
46 . . I NAP="A"!(NAP="ANY"),EMBEDNM=ABBREV S HASIT=1
47 . . I NAP="P"!(NAP="ANY"),EMBEDNM=PNAME S HASIT=1
48 Q
49 ;
50DHASIT(OBJECTDA,ONODE0,FILEDA,NAP,DHASIT) ; Does HASIT for FILEDA descendants
51 N TIUFITEM,TIUFI,MISSITEM,ITENDA,IFILEDA
52 S MISSITEM=$$MISSITEM^TIUFLF4(FILEDA)
53 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
54 D ITEMS^TIUFLT(FILEDA)
55 S TIUFI=0
56 F S TIUFI=$O(TIUFITEM(TIUFI)) Q:'TIUFI D
57 . S ITENDA=$P(TIUFITEM(TIUFI),U,2)
58 . S IFILEDA=+$G(^TIU(8925.1,FILEDA,10,+ITENDA,0))
59 . D HASIT(OBJECTDA,ONODE0,IFILEDA,NAP,.DHASIT)
60 . D DHASIT(OBJECTDA,ONODE0,IFILEDA,NAP,.DHASIT)
61DHASX Q
62 ;
63OBJUSED(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.
64 N USEDANS,TITLEDA,NODE0
65 S NODE0=^TIU(8925.1,FILEDA,0)
66 K ^TMP("TIUFEMBED",$J,FILEDA) D EMBED(FILEDA,NODE0,"ANY",1)
67 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
68 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
69OBJUX Q USEDANS
70 ;
71EMBED(OBJECTDA,ONODE0,NAP,ALLSUBS) ; Sets ^TMP("TIUFEMBED",$J,OBJECTDA,SUBSCPT,NAP,FILEDA); See top of routine.
72 ; Sets ^TMP("TIUFEMBED",$J,OBJECTDA,"TIUFTL",NAP,FILEDA) = status of FILEDA for Titles only: ACTIVE or TEST or INACTIVE or "".
73 ; If ALLSUBS=1, sets array for subscripts TIUFTL, TIUFCO and TIUFORPHAN. Otherwise, just sets TIUFTL.
74 N PARENT,FILEDA,TNODE0,STATUS,CONODE0
75 K ^TMP("TIUFEMBED",$J,OBJECTDA)
76 I '$G(ALLSUBS) S ALLSUBS=0
77 S FILEDA=0 F S FILEDA=$O(^TIU(8925.1,"AT","DOC",FILEDA)) Q:'FILEDA D
78 . S TNODE0=$G(^TIU(8925.1,FILEDA,0)) I TNODE0="" W !!,"Title ",FILEDA," from the AT cross reference does not exist; see IRM",! Q
79 . S (HASIT,DHASIT)=0
80 . D HASIT(OBJECTDA,ONODE0,FILEDA,NAP,.HASIT)
81 . D DHASIT(OBJECTDA,ONODE0,FILEDA,NAP,.DHASIT)
82 . I 'HASIT,'DHASIT Q
83 . I 'DHASIT S ^TMP("TIUFEMBED",$J,OBJECTDA,"TIUFCO",NAP,FILEDA)=""
84 . S TNODE0=^TIU(8925.1,FILEDA,0),STATUS=$$STATWORD^TIUFLF5($P(TNODE0,U,7))
85 . S ^TMP("TIUFEMBED",$J,OBJECTDA,"TIUFTL",NAP,FILEDA)=STATUS
86 I 'ALLSUBS Q
87 S FILEDA=0 F S FILEDA=$O(^TIU(8925.1,"AT","CO",FILEDA)) Q:'FILEDA D
88 . S CONODE0=$G(^TIU(8925.1,FILEDA,0)) I CONODE0="" W !!,"Component ",FILEDA," from the AT cross reference does not exist; see IRM",! Q
89 . I $D(^TIU(8925.1,"AD",FILEDA)) Q
90 . S (HASIT,DHASIT)=0
91 . D HASIT(OBJECTDA,ONODE0,FILEDA,NAP,.HASIT)
92 . D DHASIT(OBJECTDA,ONODE0,FILEDA,NAP,.DHASIT)
93 . I 'HASIT,'DHASIT Q
94 . S ^TMP("TIUFEMBED",$J,OBJECTDA,"TIUFORPHAN",NAP,FILEDA)=""
95 Q
96 ;
Note: See TracBrowser for help on using the repository browser.