PXRMEXU1 ; SLC/PKR/PJH - Reminder exchange repository utilities, #1.;10/23/2020
;;2.0;CLINICAL REMINDERS;**6,12,16,26,45,42**;Feb 04, 2005;Build 245
;=====================================================
DELETE(LIST) ;Delete the repository entries in LIST.
N DA,DIK,IND,LNUM
S DIK="^PXD(811.8,"
F IND=1:1:$L(LIST,",")-1 D
. S LNUM=$P(LIST,",",IND)
. S DA=$$RIEN^PXRMEXU1(LNUM)
. D ^DIK
Q
;
;=====================================================
DELHIST(RIEN,IHIEN) ;Delete install history IHIEN in repository entry RIEN.
N DA,DIK
S DA=IHIEN,DA(1)=RIEN
S DIK="^PXD(811.8,"_DA(1)_",130,"
D ^DIK
Q
;
;=====================================================
DESC(RIEN,DESL,DESC,KEYWORD) ;Build the description.
N JND,LC,NKEYWL
S LC=1,^PXD(811.8,RIEN,110,LC,0)="Source: "_DESL("SOURCE")
S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)="Date Packed: "_DESL("DATEP")
S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)="Package Version: "_DESL("VRSN")
S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)=""
;Add the user's description.
S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)="Description:"
F JND=1:1:+$P($G(@DESC@(1,0)),U,4) D
. S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)=@DESC@(1,JND,0)
S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)=""
;Add the keywords.
S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)="Keywords:"
S NKEYWL=+$P($G(@KEYWORD@(1,0)),U,4)
F JND=1:1:NKEYWL D
. S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)=@KEYWORD@(1,JND,0)
S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)=""
S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)="Components:"
S ^PXD(811.8,RIEN,110,0)=U_811.804_U_LC_U_LC
Q
;
;=====================================================
RIEN(LNUM) ;Given the list number return the repository ien.
N RIEN
S RIEN=$G(^TMP("PXRMEXLR",$J,"SEL",LNUM))
Q RIEN
;
;=====================================================
PATTR(IEN) ;Build the Packing Attribute list.
N ATTRLIST,DONE,FDA,IENS,INDEXAT,LN,MSG,NATTR,TEXT
S TEXT=^PXD(811.8,IEN,100,4,0)
S INDEXAT=$$GETTAGV^PXRMEXU3(TEXT,"<INDEX_AT>",10)
S (DONE,NATTR)=0
S LN=10
F Q:DONE D
. S LN=LN+1
. I LN=INDEXAT S DONE=1 Q
. S TEXT=^PXD(811.8,IEN,100,LN,0)
. I TEXT["</ATTRIBUTE>" S NATTR=NATTR+1,ATTRLIST(NATTR)=$$GETTAGV^PXRMEXU3(TEXT,"<ATTRIBUTE>",11)
. I TEXT["</PACKING ATTRIBUTES>" S DONE=1 Q
I NATTR=0 S NATTR=1,ATTRLIST(1)="NONE"
F LN=1:1:NATTR D
. S IENS="+"_LN_","_IEN_","
. S FDA(811.805,IENS,.01)=ATTRLIST(LN)
D UPDATE^DIE("S","FDA","","MSG")
I $D(MSG) D
. K TEXT
. S TEXT(1)="Storage of the Packing Attributes failed."
. S TEXT(2)="Examine the following error message for the reason."
. S TEXT(3)=""
. S TEXT(4)="The update failed, UPDATE^DIE returned the following error message:"
. D MES^XPDUTL(.TEXT)
. D AWRITE^PXRMUTIL("MSG")
Q
;
;=====================================================
SAVHIST ;Save the installation history in the repository.
N ACTION,DATE,CMPNT,FTYPE,IND,INDEX,ITEM,JND,KND,NEWNAME
N SUB,TEMP,TOTAL,TYPE,USER
;Find the first open spot in the Installation History node.
S (IND,JND)=0
F S IND=+$O(^PXD(811.8,PXRMRIEN,130,IND)) S JND=JND+1 Q:(IND=0)!(IND>JND)
S IND=JND
S JND=0
F SUB="PXRMEXIA","PXRMEXIAD" D
. S INDEX=0
. F S INDEX=$O(^TMP(SUB,$J,INDEX)) Q:+INDEX=0 D
.. S JND=JND+1
.. S CMPNT=$O(^TMP(SUB,$J,INDEX,""))
.. S ITEM=$O(^TMP(SUB,$J,INDEX,CMPNT,""))
.. S ACTION=$O(^TMP(SUB,$J,INDEX,CMPNT,ITEM,""))
.. S NEWNAME=$G(^TMP(SUB,$J,INDEX,CMPNT,ITEM,ACTION))
.. S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,0)=INDEX_U_CMPNT_U_ITEM_U_ACTION_U_NEWNAME
..;Set the 0 node.
.. S ^PXD(811.8,PXRMRIEN,130,IND,1,0)=U_"811.8031A"_U_JND_U_JND
..;Check for finding item changes and save them.
.. S FTYPE=""
.. I CMPNT["DEFINITION" S FTYPE="DEFF"
.. I CMPNT["DIALOG" S FTYPE="DIAF"
.. I CMPNT["TERM" S FTYPE="TRMF"
.. I (FTYPE'=""),($D(^TMP(SUB,$J,FTYPE))) D
... N FI,FINDING,OFINDING
... S KND=2
... S FI=""
... F S FI=$O(^TMP(SUB,$J,FTYPE,FI)) Q:FI="" D
.... S OFINDING=$O(^TMP(SUB,$J,FTYPE,FI,""))
.... S FINDING=^TMP(SUB,$J,FTYPE,FI,OFINDING)
.... I OFINDING=FINDING Q
.... S KND=KND+1
.... S TEMP=$E(OFINDING,1,33)
.... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,KND,0)=" "_TEMP_$$INSCHR^PXRMEXLC((35-$L(TEMP))," ")_FINDING
... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,0)=U_"811.80315A"_U_KND_U_KND
... I KND>2 D
.... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,1,0)=" Finding Changes"
.... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,2,0)=" Original"_$$INSCHR^PXRMEXLC(27," ")_"New"
..;
..;Check for TIU template replacements and save them.
.. I CMPNT["DIALOG" S FTYPE="DIATIU"
.. E S FTYPE=""
.. I (FTYPE'=""),($D(^TMP(SUB,$J,FTYPE))) D
... N OTIUT,TIUT,TYPE
... S TYPE=""
... S KND=2
... F S TYPE=$O(^TMP(SUB,$J,FTYPE,TYPE)) Q:TYPE="" D
.... S OTIUT=""
.... F S OTIUT=$O(^TMP(SUB,$J,FTYPE,TYPE,OTIUT)) Q:OTIUT="" D
..... S TIUT=$G(^TMP(SUB,$J,FTYPE,TYPE,OTIUT))
..... I OTIUT=TIUT Q
..... I '$D(^TMP(SUB,$J,FTYPE,TYPE,OTIUT,ITEM)) Q
..... S KND=KND+1
..... S TEMP=$E(OTIUT,1,33)
..... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,KND,0)=" "_TEMP_$$INSCHR^PXRMEXLC((35-$L(TEMP))," ")_TIUT
.... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,0)=U_"811.80315A"_U_KND_U_KND
.... I KND>2 D
..... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,1,0)=" "_TYPE
..... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,2,0)=" Original"_$$INSCHR^PXRMEXLC(27," ")_"New"
;If JND is still 0 then there was nothing to save.
I JND>0 D
.;Save the header information.
. S DATE=$$NOW^XLFDT
. S TYPE=$G(^TMP("PXRMEXIA",$J,"TYPE"))
. I TYPE="" S TYPE="INTERACTIVE"
. S USER=$$GET1^DIQ(200,DUZ,.01,"")
. S ^PXD(811.8,PXRMRIEN,130,IND,0)=DATE_U_USER_U_TYPE
. S ^PXD(811.8,PXRMRIEN,130,"B",DATE,IND)=""
.;Set the 0 node.
. S (KND,TOTAL)=0
. F S KND=+$O(^PXD(811.8,PXRMRIEN,130,KND)) Q:KND=0 S TOTAL=TOTAL+1
. S ^PXD(811.8,PXRMRIEN,130,0)=U_"811.803DA"_U_IND_U_TOTAL
K ^TMP("PXRMEXIA",$J)
K ^TMP("PXRMEXIAD",$J)
Q
;
;=====================================================
TIUSRCH(GLOB,IEN,NODE,OLIST,TLIST) ;Extract TIU Objects/Templates
;from any WP text.
N NIN,NOUT,OCNT,SUB,TCNT,TEXT,TEXTIN,TEXTOUT
;Add to existing arrays
S NIN=0
S OCNT=+$O(OLIST(""),-1),TCNT=+$O(TLIST(""),-1),SUB=0
;Scan WP fields
F S SUB=$O(@(GLOB_IEN_","_NODE_","_SUB_")")) Q:'SUB D
.;Get individual line
.S TEXT=$G(@(GLOB_IEN_","_NODE_","_SUB_",0)")) Q:TEXT=""
.S NIN=NIN+1
.S TEXTIN(NIN)=TEXT
D FORMAT^PXRMTEXT(0,80,NIN,.TEXTIN,.NOUT,.TEXTOUT)
F X=1:1:NOUT D
.S TEXT=TEXTOUT(X)
.;Most text lines will have no TIU link so ignore them
.I (TEXT'["|")&(TEXT'["{FLD:") Q
.;Templates are in format {FLD:fldname} (only applies to dialogs)
.I GLOB[801.41 D TIUXTR("{FLD:","}",TEXT,.TLIST,.TCNT)
.;Objects are in format |Objectname|
.D TIUXTR("|","|",TEXT,.OLIST,.OCNT)
Q
;
;=====================================================
TIUXTR(SRCH,SRCH1,TEXT,OUTPUT,CNT) ;
N EXIST,IC,ONAME,TMP,TXT
S TXT=TEXT
F D Q:TXT'[SRCH
.S TXT=$E(TXT,$F(TXT,SRCH),$L(TXT)) Q:TXT'[SRCH1
.S ONAME=$P(TXT,SRCH1) Q:ONAME=""
.I SRCH1="}" S TMP=$P(TXT,SRCH1,2) I $E(TMP,1,3)="FMT" Q
.;
.;Remove the valid item from the text string. This prevent problems
.;with multiple objects on one line.
.;
.S TXT=$P(TXT,ONAME_SRCH1,2)
.;Check if already selected
.S EXIST=0,IC=0
.F S IC=$O(OUTPUT(IC)) Q:'IC Q:EXIST D
..I $G(OUTPUT(IC))=ONAME S EXIST=1
.;Save array of object/template names
.I 'EXIST S CNT=CNT+1,OUTPUT(CNT)=ONAME
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEXU1 7483 printed Dec 13, 2024@01:45:17 Page 2
PXRMEXU1 ; SLC/PKR/PJH - Reminder exchange repository utilities, #1.;10/23/2020
+1 ;;2.0;CLINICAL REMINDERS;**6,12,16,26,45,42**;Feb 04, 2005;Build 245
+2 ;=====================================================
DELETE(LIST) ;Delete the repository entries in LIST.
+1 NEW DA,DIK,IND,LNUM
+2 SET DIK="^PXD(811.8,"
+3 FOR IND=1:1:$LENGTH(LIST,",")-1
Begin DoDot:1
+4 SET LNUM=$PIECE(LIST,",",IND)
+5 SET DA=$$RIEN^PXRMEXU1(LNUM)
+6 DO ^DIK
End DoDot:1
+7 QUIT
+8 ;
+9 ;=====================================================
DELHIST(RIEN,IHIEN) ;Delete install history IHIEN in repository entry RIEN.
+1 NEW DA,DIK
+2 SET DA=IHIEN
SET DA(1)=RIEN
+3 SET DIK="^PXD(811.8,"_DA(1)_",130,"
+4 DO ^DIK
+5 QUIT
+6 ;
+7 ;=====================================================
DESC(RIEN,DESL,DESC,KEYWORD) ;Build the description.
+1 NEW JND,LC,NKEYWL
+2 SET LC=1
SET ^PXD(811.8,RIEN,110,LC,0)="Source: "_DESL("SOURCE")
+3 SET LC=LC+1
SET ^PXD(811.8,RIEN,110,LC,0)="Date Packed: "_DESL("DATEP")
+4 SET LC=LC+1
SET ^PXD(811.8,RIEN,110,LC,0)="Package Version: "_DESL("VRSN")
+5 SET LC=LC+1
SET ^PXD(811.8,RIEN,110,LC,0)=""
+6 ;Add the user's description.
+7 SET LC=LC+1
SET ^PXD(811.8,RIEN,110,LC,0)="Description:"
+8 FOR JND=1:1:+$PIECE($GET(@DESC@(1,0)),U,4)
Begin DoDot:1
+9 SET LC=LC+1
SET ^PXD(811.8,RIEN,110,LC,0)=@DESC@(1,JND,0)
End DoDot:1
+10 SET LC=LC+1
SET ^PXD(811.8,RIEN,110,LC,0)=""
+11 ;Add the keywords.
+12 SET LC=LC+1
SET ^PXD(811.8,RIEN,110,LC,0)="Keywords:"
+13 SET NKEYWL=+$PIECE($GET(@KEYWORD@(1,0)),U,4)
+14 FOR JND=1:1:NKEYWL
Begin DoDot:1
+15 SET LC=LC+1
SET ^PXD(811.8,RIEN,110,LC,0)=@KEYWORD@(1,JND,0)
End DoDot:1
+16 SET LC=LC+1
SET ^PXD(811.8,RIEN,110,LC,0)=""
+17 SET LC=LC+1
SET ^PXD(811.8,RIEN,110,LC,0)="Components:"
+18 SET ^PXD(811.8,RIEN,110,0)=U_811.804_U_LC_U_LC
+19 QUIT
+20 ;
+21 ;=====================================================
RIEN(LNUM) ;Given the list number return the repository ien.
+1 NEW RIEN
+2 SET RIEN=$GET(^TMP("PXRMEXLR",$JOB,"SEL",LNUM))
+3 QUIT RIEN
+4 ;
+5 ;=====================================================
PATTR(IEN) ;Build the Packing Attribute list.
+1 NEW ATTRLIST,DONE,FDA,IENS,INDEXAT,LN,MSG,NATTR,TEXT
+2 SET TEXT=^PXD(811.8,IEN,100,4,0)
+3 SET INDEXAT=$$GETTAGV^PXRMEXU3(TEXT,"<INDEX_AT>",10)
+4 SET (DONE,NATTR)=0
+5 SET LN=10
+6 FOR
if DONE
QUIT
Begin DoDot:1
+7 SET LN=LN+1
+8 IF LN=INDEXAT
SET DONE=1
QUIT
+9 SET TEXT=^PXD(811.8,IEN,100,LN,0)
+10 IF TEXT["</ATTRIBUTE>"
SET NATTR=NATTR+1
SET ATTRLIST(NATTR)=$$GETTAGV^PXRMEXU3(TEXT,"<ATTRIBUTE>",11)
+11 IF TEXT["</PACKING ATTRIBUTES>"
SET DONE=1
QUIT
End DoDot:1
+12 IF NATTR=0
SET NATTR=1
SET ATTRLIST(1)="NONE"
+13 FOR LN=1:1:NATTR
Begin DoDot:1
+14 SET IENS="+"_LN_","_IEN_","
+15 SET FDA(811.805,IENS,.01)=ATTRLIST(LN)
End DoDot:1
+16 DO UPDATE^DIE("S","FDA","","MSG")
+17 IF $DATA(MSG)
Begin DoDot:1
+18 KILL TEXT
+19 SET TEXT(1)="Storage of the Packing Attributes failed."
+20 SET TEXT(2)="Examine the following error message for the reason."
+21 SET TEXT(3)=""
+22 SET TEXT(4)="The update failed, UPDATE^DIE returned the following error message:"
+23 DO MES^XPDUTL(.TEXT)
+24 DO AWRITE^PXRMUTIL("MSG")
End DoDot:1
+25 QUIT
+26 ;
+27 ;=====================================================
SAVHIST ;Save the installation history in the repository.
+1 NEW ACTION,DATE,CMPNT,FTYPE,IND,INDEX,ITEM,JND,KND,NEWNAME
+2 NEW SUB,TEMP,TOTAL,TYPE,USER
+3 ;Find the first open spot in the Installation History node.
+4 SET (IND,JND)=0
+5 FOR
SET IND=+$ORDER(^PXD(811.8,PXRMRIEN,130,IND))
SET JND=JND+1
if (IND=0)!(IND>JND)
QUIT
+6 SET IND=JND
+7 SET JND=0
+8 FOR SUB="PXRMEXIA","PXRMEXIAD"
Begin DoDot:1
+9 SET INDEX=0
+10 FOR
SET INDEX=$ORDER(^TMP(SUB,$JOB,INDEX))
if +INDEX=0
QUIT
Begin DoDot:2
+11 SET JND=JND+1
+12 SET CMPNT=$ORDER(^TMP(SUB,$JOB,INDEX,""))
+13 SET ITEM=$ORDER(^TMP(SUB,$JOB,INDEX,CMPNT,""))
+14 SET ACTION=$ORDER(^TMP(SUB,$JOB,INDEX,CMPNT,ITEM,""))
+15 SET NEWNAME=$GET(^TMP(SUB,$JOB,INDEX,CMPNT,ITEM,ACTION))
+16 SET ^PXD(811.8,PXRMRIEN,130,IND,1,JND,0)=INDEX_U_CMPNT_U_ITEM_U_ACTION_U_NEWNAME
+17 ;Set the 0 node.
+18 SET ^PXD(811.8,PXRMRIEN,130,IND,1,0)=U_"811.8031A"_U_JND_U_JND
+19 ;Check for finding item changes and save them.
+20 SET FTYPE=""
+21 IF CMPNT["DEFINITION"
SET FTYPE="DEFF"
+22 IF CMPNT["DIALOG"
SET FTYPE="DIAF"
+23 IF CMPNT["TERM"
SET FTYPE="TRMF"
+24 IF (FTYPE'="")
IF ($DATA(^TMP(SUB,$JOB,FTYPE)))
Begin DoDot:3
+25 NEW FI,FINDING,OFINDING
+26 SET KND=2
+27 SET FI=""
+28 FOR
SET FI=$ORDER(^TMP(SUB,$JOB,FTYPE,FI))
if FI=""
QUIT
Begin DoDot:4
+29 SET OFINDING=$ORDER(^TMP(SUB,$JOB,FTYPE,FI,""))
+30 SET FINDING=^TMP(SUB,$JOB,FTYPE,FI,OFINDING)
+31 IF OFINDING=FINDING
QUIT
+32 SET KND=KND+1
+33 SET TEMP=$EXTRACT(OFINDING,1,33)
+34 SET ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,KND,0)=" "_TEMP_$$INSCHR^PXRMEXLC((35-$LENGTH(TEMP))," ")_FINDING
End DoDot:4
+35 SET ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,0)=U_"811.80315A"_U_KND_U_KND
+36 IF KND>2
Begin DoDot:4
+37 SET ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,1,0)=" Finding Changes"
+38 SET ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,2,0)=" Original"_$$INSCHR^PXRMEXLC(27," ")_"New"
End DoDot:4
End DoDot:3
+39 ;
+40 ;Check for TIU template replacements and save them.
+41 IF CMPNT["DIALOG"
SET FTYPE="DIATIU"
+42 IF '$TEST
SET FTYPE=""
+43 IF (FTYPE'="")
IF ($DATA(^TMP(SUB,$JOB,FTYPE)))
Begin DoDot:3
+44 NEW OTIUT,TIUT,TYPE
+45 SET TYPE=""
+46 SET KND=2
+47 FOR
SET TYPE=$ORDER(^TMP(SUB,$JOB,FTYPE,TYPE))
if TYPE=""
QUIT
Begin DoDot:4
+48 SET OTIUT=""
+49 FOR
SET OTIUT=$ORDER(^TMP(SUB,$JOB,FTYPE,TYPE,OTIUT))
if OTIUT=""
QUIT
Begin DoDot:5
+50 SET TIUT=$GET(^TMP(SUB,$JOB,FTYPE,TYPE,OTIUT))
+51 IF OTIUT=TIUT
QUIT
+52 IF '$DATA(^TMP(SUB,$JOB,FTYPE,TYPE,OTIUT,ITEM))
QUIT
+53 SET KND=KND+1
+54 SET TEMP=$EXTRACT(OTIUT,1,33)
+55 SET ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,KND,0)=" "_TEMP_$$INSCHR^PXRMEXLC((35-$LENGTH(TEMP))," ")_TIUT
End DoDot:5
+56 SET ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,0)=U_"811.80315A"_U_KND_U_KND
+57 IF KND>2
Begin DoDot:5
+58 SET ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,1,0)=" "_TYPE
+59 SET ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,2,0)=" Original"_$$INSCHR^PXRMEXLC(27," ")_"New"
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+60 ;If JND is still 0 then there was nothing to save.
+61 IF JND>0
Begin DoDot:1
+62 ;Save the header information.
+63 SET DATE=$$NOW^XLFDT
+64 SET TYPE=$GET(^TMP("PXRMEXIA",$JOB,"TYPE"))
+65 IF TYPE=""
SET TYPE="INTERACTIVE"
+66 SET USER=$$GET1^DIQ(200,DUZ,.01,"")
+67 SET ^PXD(811.8,PXRMRIEN,130,IND,0)=DATE_U_USER_U_TYPE
+68 SET ^PXD(811.8,PXRMRIEN,130,"B",DATE,IND)=""
+69 ;Set the 0 node.
+70 SET (KND,TOTAL)=0
+71 FOR
SET KND=+$ORDER(^PXD(811.8,PXRMRIEN,130,KND))
if KND=0
QUIT
SET TOTAL=TOTAL+1
+72 SET ^PXD(811.8,PXRMRIEN,130,0)=U_"811.803DA"_U_IND_U_TOTAL
End DoDot:1
+73 KILL ^TMP("PXRMEXIA",$JOB)
+74 KILL ^TMP("PXRMEXIAD",$JOB)
+75 QUIT
+76 ;
+77 ;=====================================================
TIUSRCH(GLOB,IEN,NODE,OLIST,TLIST) ;Extract TIU Objects/Templates
+1 ;from any WP text.
+2 NEW NIN,NOUT,OCNT,SUB,TCNT,TEXT,TEXTIN,TEXTOUT
+3 ;Add to existing arrays
+4 SET NIN=0
+5 SET OCNT=+$ORDER(OLIST(""),-1)
SET TCNT=+$ORDER(TLIST(""),-1)
SET SUB=0
+6 ;Scan WP fields
+7 FOR
SET SUB=$ORDER(@(GLOB_IEN_","_NODE_","_SUB_")"))
if 'SUB
QUIT
Begin DoDot:1
+8 ;Get individual line
+9 SET TEXT=$GET(@(GLOB_IEN_","_NODE_","_SUB_",0)"))
if TEXT=""
QUIT
+10 SET NIN=NIN+1
+11 SET TEXTIN(NIN)=TEXT
End DoDot:1
+12 DO FORMAT^PXRMTEXT(0,80,NIN,.TEXTIN,.NOUT,.TEXTOUT)
+13 FOR X=1:1:NOUT
Begin DoDot:1
+14 SET TEXT=TEXTOUT(X)
+15 ;Most text lines will have no TIU link so ignore them
+16 IF (TEXT'["|")&(TEXT'["{FLD:")
QUIT
+17 ;Templates are in format {FLD:fldname} (only applies to dialogs)
+18 IF GLOB[801.41
DO TIUXTR("{FLD:","}",TEXT,.TLIST,.TCNT)
+19 ;Objects are in format |Objectname|
+20 DO TIUXTR("|","|",TEXT,.OLIST,.OCNT)
End DoDot:1
+21 QUIT
+22 ;
+23 ;=====================================================
TIUXTR(SRCH,SRCH1,TEXT,OUTPUT,CNT) ;
+1 NEW EXIST,IC,ONAME,TMP,TXT
+2 SET TXT=TEXT
+3 FOR
Begin DoDot:1
+4 SET TXT=$EXTRACT(TXT,$FIND(TXT,SRCH),$LENGTH(TXT))
if TXT'[SRCH1
QUIT
+5 SET ONAME=$PIECE(TXT,SRCH1)
if ONAME=""
QUIT
+6 IF SRCH1="}"
SET TMP=$PIECE(TXT,SRCH1,2)
IF $EXTRACT(TMP,1,3)="FMT"
QUIT
+7 ;
+8 ;Remove the valid item from the text string. This prevent problems
+9 ;with multiple objects on one line.
+10 ;
+11 SET TXT=$PIECE(TXT,ONAME_SRCH1,2)
+12 ;Check if already selected
+13 SET EXIST=0
SET IC=0
+14 FOR
SET IC=$ORDER(OUTPUT(IC))
if 'IC
QUIT
if EXIST
QUIT
Begin DoDot:2
+15 IF $GET(OUTPUT(IC))=ONAME
SET EXIST=1
End DoDot:2
+16 ;Save array of object/template names
+17 IF 'EXIST
SET CNT=CNT+1
SET OUTPUT(CNT)=ONAME
End DoDot:1
if TXT'[SRCH
QUIT
+18 QUIT
+19 ;
