TIUFLF7 ; SLC/MAM - Library; File 8925.1: POSSTYPE(PFILEDA),TYPELIST(NAME,FILEDA,PFILEDA,TYPEMSG,TYPELIST),EDTYPE(FILEDA,NODE0,PFILEDA,XFLG,USED),DUPNAME(NAME,FILEDA),DUPITEM(NAME,PFILEDA,FILEDA),DDEFIEN(TIUDEFNM,etc) ;5/2/05
;;1.0;TEXT INTEGRATION UTILITIES;**2,17,90,184**;Jun 20, 1997
;
POSSTYPE(PFILEDA) ; Function returns possible Types an Entry may have to
;be consistent with its parent, e.g. ^CL^DC^
; If parent has bad type or no type, Returns POSSTYPE="".
; If PFILEDA = 0, Returns all Types including Object.
; Requires PFILEDA = 8925.1 IFN of parent of Entry;
; = 0 if Entry has no parent, actual or prospective.
; Shared CO can have more than 1 parent. But any parent will determine the type of the Child to be a CO, so OK to check only 1 parent.
N PNODE0,POSSTYPE,PTYPE
S POSSTYPE=""
I 'PFILEDA S POSSTYPE="^CL^DC^DOC^CO^O^" G POSTX
S PNODE0=$G(^TIU(8925.1,PFILEDA,0)) I '$D(PNODE0) W !!," File entry "_PFILEDA_" does not exist in File; See IRM",! D PAUSE^TIUFXHLX G POSTX
S PTYPE=$P(PNODE0,U,4)
S POSSTYPE=$S(PTYPE="CL":"^CL^DC^",PTYPE="DC":"^DOC^",PTYPE="CO"!(PTYPE="DOC"):"^CO^",1:"")
POSTX Q POSSTYPE
;
TYPELIST(NAME,FILEDA,PFILEDA,TYPEMSG,TYPELIST) ; Module sets list of possible types, sets msg array TYPEMSG explaining nonparent limits on type.
; Requires NAME of entry being checked
; Requires PFILEDA=IFN of parent if entry has actual or prospective parent (as in Create, Add Items)
; Requires FILEDA if entry already exists in the file
; Optional TYPEMSG
; Optional TYPELIST: Returns TYPELIST = subset of CL,DC,DOC,CO,O
;representing permitted Types. Example: ^CL^DOC^
;If has parent, parent already has item w same name, then TYPELIST=""
N DUPNAME,POSSTYPE,TYPE,REST,FDATYPE
S FILEDA=+$G(FILEDA),PFILEDA=+$G(PFILEDA),TYPELIST=""
S FDATYPE=$S(FILEDA:$P(^TIU(8925.1,FILEDA,0),U,4),1:"")
I (FDATYPE'="CL")&(FDATYPE'="DC")&(FDATYPE'="DOC")&(FDATYPE'="CO")&(FDATYPE'="O") S FDATYPE=""
S DUPNAME=$$DUPNAME(NAME,FILEDA)
S POSSTYPE=$$POSSTYPE(PFILEDA) G:$D(DTOUT) TYPEX
I POSSTYPE="" S TYPEMSG("T")="Parent has No Type/Wrong Type" G TYPEX
I FDATYPE="O"!(TIUFTMPL="J") S TYPELIST="^O^" G TYPEX
S REST="" F TYPE="CL","DC","DOC","CO","O" I POSSTYPE[(U_TYPE_U) D
. I DUPNAME[(U_TYPE_U) S:TYPE'="DOC" REST=$S(REST'="":REST_" or "_TYPE,1:TYPE) S:TYPE="DOC" REST=$S(REST'="":REST_" or TL",1:"TL") Q
. I TYPE="O" D Q
. . I FDATYPE'="" Q
. . I '$$BADNAP^TIUFLF1(NAME,FILEDA,1) S TYPELIST=TYPELIST_U_TYPE Q
. . S TYPEMSG("O")=" Type cannot be Object; Object would be ambiguous"
. S TYPELIST=TYPELIST_U_TYPE
I TYPELIST'="" S TYPELIST=TYPELIST_U
I REST'="" S TYPEMSG("R")=" Type cannot be "_REST_"; File already has",TYPEMSG("R1")="an entry of that Type with the same Name" Q
TYPEX Q
;
DUPNAME(NAME,FILEDA) ; Function returns 1 if NAME already
;exists in file for entry OTHER THAN FILEDA, else 0. If 1, returns
;1^Type^Type^ etc., for example, 1^DOC^CO^ means: file has a duplicate
;name of Type DOC other than FILEDA and a duplicate name of Type CO
;other than FILEDA.
N XDUPANS,XDUPDA,TYPE
S FILEDA=+$G(FILEDA)
S (XDUPDA,XDUPANS)=0
F S XDUPDA=$O(^TIU(8925.1,"B",$E(NAME,1,60),XDUPDA)) Q:'XDUPDA D ;TIU*1*90 change to 60 chars
. I NAME=$P(^TIU(8925.1,XDUPDA,0),U),XDUPDA'=FILEDA S:'XDUPANS XDUPANS="1^" S TYPE=$P(^TIU(8925.1,XDUPDA,0),U,4) I TYPE'="" S:XDUPANS'[(U_TYPE_U) XDUPANS=XDUPANS_TYPE_U
Q XDUPANS
;
DUPITEM(NAME,PFILEDA,FILEDA) ; Function returns 1 if PFILEDA already has item
;(other than FILEDA) named NAME.
; Requires NAME, PFILEDA
; Requires FILEDA if FILEDA should be excluded from items checked for
;duplicate names
N ITEMANS,XDUPDA
S (XDUPDA,ITEMANS)=0,FILEDA=+$G(FILEDA)
F S XDUPDA=$O(^TIU(8925.1,"B",$E(NAME,1,60),XDUPDA)) Q:'XDUPDA D Q:ITEMANS ; TIU*1*90 change to 60 chars
. I NAME=$P(^TIU(8925.1,XDUPDA,0),U),$D(^TIU(8925.1,"AD",XDUPDA,PFILEDA)),XDUPDA'=FILEDA S ITEMANS=1
I ITEMANS S TIUFIMSG=" Please enter a different Name; Parent already has Item with that Name"
DUPIX Q ITEMANS
;
DUP(NAME,PFILEDA,FILEDA) ; Function returns 1 if PFILEDA already has item
;(possibly FILEDA itself if FILEDA is Shared) named NAME.
; Requires NAME, PFILEDA, FILEDA; Used in NAMSCRN^TIUFLF2
; FILEDA is potential, not actual item of PFILEDA.
N DUPANS S DUPANS=0
;Patch 13: Set TIUFIMSG here so NAMSCRN (which calls DUP) always sets
;it:
I $D(^TIU(8925.1,PFILEDA,10,"B",FILEDA)) S DUPANS=1,TIUFIMSG=" Please enter a different Name; Parent already has Item with that Name" G DUPX
S DUPANS=$$DUPITEM(NAME,PFILEDA,FILEDA)
DUPX Q DUPANS
;
EDTYPE(FILEDA,NODE0,PFILEDA,XFLG,USED) ; User edit FILEDA Type.
; Requires FILEDA, NODE0.
; Requires PFILEDA if DA has an actual/prospective parent. Need PFILEDA
;for add items/Create DDEF - they're not in AD xref because not items
;yet.
; Updates NODE0 (not the array, just the node).
; Returns XFLG=1 if user ^exited or timed out, else as received.
; Requires USED =1 for object or $$DDEFUSED^TIUFLF
N TYPE,X,Y,NAME,TIUFTMSG,TIUFTLST,DEFLT,DIE,DR
K DIRUT,DUOUT,DIROUT
I $P(NODE0,U,4)="O" W !!,"TYPE: Object. Can't edit Type",! G EDTYX
I USED="YES"!(USED="ERROR") W !!,"TYPE: Entry In Use by Documents; Can't edit Type",! G EDTYX
S PFILEDA=+$G(PFILEDA),NAME=$P(NODE0,U)
D TYPELIST(NAME,FILEDA,PFILEDA,.TIUFTMSG,.TIUFTLST) G:$D(DTOUT) EDTYX
I $D(TIUFTMSG("T")) W !!,TIUFTMSG("T"),!,"Can't edit Type" S XFLG=1 D PAUSE^TIUFXHLX G EDTYX
I $D(TIUFTMSG("R")),$D(TIUFTMSG("R1")) W !!,TIUFTMSG("R"),!,TIUFTMSG("R1"),!
I $D(TIUFTMSG("O")) W:'$D(TIUFTMSG("R")) ! W TIUFTMSG("O"),!
I TIUFTLST="" W !!,"TYPE: ",$S($D(TIUFTMSG):TIUFTMSG(1),1:" Faulty entry; File has entries of every permitted Type with the same Name"),! D PAUSE^TIUFXHLX S XFLG=1 G EDTYX
S DEFLT=$P(NODE0,U,4) S:$L(TIUFTLST,U)=3 DEFLT=$P(TIUFTLST,U,2) S:DEFLT="DOC" DEFLT="TL"
READTYP K DUOUT S TYPE=$S(DEFLT'="":$$SELTYPE^TIUFLF8(FILEDA,DEFLT),1:$$SELTYPE^TIUFLF8(FILEDA))
I $D(DUOUT)!$D(DTOUT) G EDTYX
I TYPE="" W " ?? Enter appropriate Type or '^' to exit",! H 2 G READTYP
S:TYPE="TL" TYPE="DOC" S DIE=8925.1,DR=".04////"_TYPE D ^DIE
S NODE0=^TIU(8925.1,FILEDA,0)
EDTYX S:$D(DUOUT)!$D(DTOUT) XFLG=1
Q
;
DDEFIEN(TIUDEFNM,TIUTYPE) ; Function gets IEN (and more) of Doc Def
;Requires TIUDEFNM - .01 name of Title, Docmt Class or Class in
; the Document Definition file #8925.1
;Requires TIUTYPE - Expected type of DDEF: TL or DC or CL
;Returns IEN^STATUS^NATL if exactly one DDEF of type TIUTYPE
; is found
; or 0^ErrMsg
; NOTE: Only ONE DDEF of a given type is allowed in 8925.1.
; If DDEFs are created using TIU DDEF options, that is enforced.
; If DDEFs are created in a patch, the patch MUST
; enforce it.
;As a precaution, this module returns 0^ErrMsg if duplicates are found.
;However, TIU code ASSUMES there are no duplicates within a type.
N TIUDEFDA,GOTIT,ERRMSG,TIUNODE0
S TIUTYPE=$G(TIUTYPE)
I TIUTYPE'="TL",TIUTYPE'="DC",TIUTYPE'="CL" Q "0^Type Required"
I TIUTYPE="TL" S TIUTYPE="DOC"
S TIUDEFDA=0
; -- Not in B xref:
I '$O(^TIU(8925.1,"B",TIUDEFNM,0)) S ERRMSG="0^Entry not found" Q ERRMSG
F S TIUDEFDA=+$O(^TIU(8925.1,"B",TIUDEFNM,TIUDEFDA)) Q:TIUDEFDA'>0 D Q:$D(ERRMSG)
. S TIUNODE0=$G(^TIU(8925.1,TIUDEFDA,0))
. ; -- Not in file or not right type:
. I $P(TIUNODE0,U,4)'=TIUTYPE Q
. ; -- Second good one:
. I $D(GOTIT) S ERRMSG="0^Duplicates found" Q
. ; -- First good one; set GOTIT=IEN^STATUS^NATL:
. S GOTIT=TIUDEFDA_U_$P(TIUNODE0,U,7)_U_$P(TIUNODE0,U,13)
; -- Not in B xref, or dups:
I $D(ERRMSG) Q ERRMSG
; Good one w/o dups:
I $D(GOTIT) Q GOTIT
; In B xref but not in file, or bad type:
Q "0^Entry not found"
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFLF7 7787 printed Apr 09, 2024@21:46:48 Page 2
TIUFLF7 ; SLC/MAM - Library; File 8925.1: POSSTYPE(PFILEDA),TYPELIST(NAME,FILEDA,PFILEDA,TYPEMSG,TYPELIST),EDTYPE(FILEDA,NODE0,PFILEDA,XFLG,USED),DUPNAME(NAME,FILEDA),DUPITEM(NAME,PFILEDA,FILEDA),DDEFIEN(TIUDEFNM,etc) ;5/2/05
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**2,17,90,184**;Jun 20, 1997
+2 ;
POSSTYPE(PFILEDA) ; Function returns possible Types an Entry may have to
+1 ;be consistent with its parent, e.g. ^CL^DC^
+2 ; If parent has bad type or no type, Returns POSSTYPE="".
+3 ; If PFILEDA = 0, Returns all Types including Object.
+4 ; Requires PFILEDA = 8925.1 IFN of parent of Entry;
+5 ; = 0 if Entry has no parent, actual or prospective.
+6 ; Shared CO can have more than 1 parent. But any parent will determine the type of the Child to be a CO, so OK to check only 1 parent.
+7 NEW PNODE0,POSSTYPE,PTYPE
+8 SET POSSTYPE=""
+9 IF 'PFILEDA
SET POSSTYPE="^CL^DC^DOC^CO^O^"
GOTO POSTX
+10 SET PNODE0=$GET(^TIU(8925.1,PFILEDA,0))
IF '$DATA(PNODE0)
WRITE !!," File entry "_PFILEDA_" does not exist in File; See IRM",!
DO PAUSE^TIUFXHLX
GOTO POSTX
+11 SET PTYPE=$PIECE(PNODE0,U,4)
+12 SET POSSTYPE=$SELECT(PTYPE="CL":"^CL^DC^",PTYPE="DC":"^DOC^",PTYPE="CO"!(PTYPE="DOC"):"^CO^",1:"")
POSTX QUIT POSSTYPE
+1 ;
TYPELIST(NAME,FILEDA,PFILEDA,TYPEMSG,TYPELIST) ; Module sets list of possible types, sets msg array TYPEMSG explaining nonparent limits on type.
+1 ; Requires NAME of entry being checked
+2 ; Requires PFILEDA=IFN of parent if entry has actual or prospective parent (as in Create, Add Items)
+3 ; Requires FILEDA if entry already exists in the file
+4 ; Optional TYPEMSG
+5 ; Optional TYPELIST: Returns TYPELIST = subset of CL,DC,DOC,CO,O
+6 ;representing permitted Types. Example: ^CL^DOC^
+7 ;If has parent, parent already has item w same name, then TYPELIST=""
+8 NEW DUPNAME,POSSTYPE,TYPE,REST,FDATYPE
+9 SET FILEDA=+$GET(FILEDA)
SET PFILEDA=+$GET(PFILEDA)
SET TYPELIST=""
+10 SET FDATYPE=$SELECT(FILEDA:$PIECE(^TIU(8925.1,FILEDA,0),U,4),1:"")
+11 IF (FDATYPE'="CL")&(FDATYPE'="DC")&(FDATYPE'="DOC")&(FDATYPE'="CO")&(FDATYPE'="O")
SET FDATYPE=""
+12 SET DUPNAME=$$DUPNAME(NAME,FILEDA)
+13 SET POSSTYPE=$$POSSTYPE(PFILEDA)
if $DATA(DTOUT)
GOTO TYPEX
+14 IF POSSTYPE=""
SET TYPEMSG("T")="Parent has No Type/Wrong Type"
GOTO TYPEX
+15 IF FDATYPE="O"!(TIUFTMPL="J")
SET TYPELIST="^O^"
GOTO TYPEX
+16 SET REST=""
FOR TYPE="CL","DC","DOC","CO","O"
IF POSSTYPE[(U_TYPE_U)
Begin DoDot:1
+17 IF DUPNAME[(U_TYPE_U)
if TYPE'="DOC"
SET REST=$SELECT(REST'="":REST_" or "_TYPE,1:TYPE)
if TYPE="DOC"
SET REST=$SELECT(REST'="":REST_" or TL",1:"TL")
QUIT
+18 IF TYPE="O"
Begin DoDot:2
+19 IF FDATYPE'=""
QUIT
+20 IF '$$BADNAP^TIUFLF1(NAME,FILEDA,1)
SET TYPELIST=TYPELIST_U_TYPE
QUIT
+21 SET TYPEMSG("O")=" Type cannot be Object; Object would be ambiguous"
End DoDot:2
QUIT
+22 SET TYPELIST=TYPELIST_U_TYPE
End DoDot:1
+23 IF TYPELIST'=""
SET TYPELIST=TYPELIST_U
+24 IF REST'=""
SET TYPEMSG("R")=" Type cannot be "_REST_"; File already has"
SET TYPEMSG("R1")="an entry of that Type with the same Name"
QUIT
TYPEX QUIT
+1 ;
DUPNAME(NAME,FILEDA) ; Function returns 1 if NAME already
+1 ;exists in file for entry OTHER THAN FILEDA, else 0. If 1, returns
+2 ;1^Type^Type^ etc., for example, 1^DOC^CO^ means: file has a duplicate
+3 ;name of Type DOC other than FILEDA and a duplicate name of Type CO
+4 ;other than FILEDA.
+5 NEW XDUPANS,XDUPDA,TYPE
+6 SET FILEDA=+$GET(FILEDA)
+7 SET (XDUPDA,XDUPANS)=0
+8 ;TIU*1*90 change to 60 chars
FOR
SET XDUPDA=$ORDER(^TIU(8925.1,"B",$EXTRACT(NAME,1,60),XDUPDA))
if 'XDUPDA
QUIT
Begin DoDot:1
+9 IF NAME=$PIECE(^TIU(8925.1,XDUPDA,0),U)
IF XDUPDA'=FILEDA
if 'XDUPANS
SET XDUPANS="1^"
SET TYPE=$PIECE(^TIU(8925.1,XDUPDA,0),U,4)
IF TYPE'=""
if XDUPANS'[(U_TYPE_U)
SET XDUPANS=XDUPANS_TYPE_U
End DoDot:1
+10 QUIT XDUPANS
+11 ;
DUPITEM(NAME,PFILEDA,FILEDA) ; Function returns 1 if PFILEDA already has item
+1 ;(other than FILEDA) named NAME.
+2 ; Requires NAME, PFILEDA
+3 ; Requires FILEDA if FILEDA should be excluded from items checked for
+4 ;duplicate names
+5 NEW ITEMANS,XDUPDA
+6 SET (XDUPDA,ITEMANS)=0
SET FILEDA=+$GET(FILEDA)
+7 ; TIU*1*90 change to 60 chars
FOR
SET XDUPDA=$ORDER(^TIU(8925.1,"B",$EXTRACT(NAME,1,60),XDUPDA))
if 'XDUPDA
QUIT
Begin DoDot:1
+8 IF NAME=$PIECE(^TIU(8925.1,XDUPDA,0),U)
IF $DATA(^TIU(8925.1,"AD",XDUPDA,PFILEDA))
IF XDUPDA'=FILEDA
SET ITEMANS=1
End DoDot:1
if ITEMANS
QUIT
+9 IF ITEMANS
SET TIUFIMSG=" Please enter a different Name; Parent already has Item with that Name"
DUPIX QUIT ITEMANS
+1 ;
DUP(NAME,PFILEDA,FILEDA) ; Function returns 1 if PFILEDA already has item
+1 ;(possibly FILEDA itself if FILEDA is Shared) named NAME.
+2 ; Requires NAME, PFILEDA, FILEDA; Used in NAMSCRN^TIUFLF2
+3 ; FILEDA is potential, not actual item of PFILEDA.
+4 NEW DUPANS
SET DUPANS=0
+5 ;Patch 13: Set TIUFIMSG here so NAMSCRN (which calls DUP) always sets
+6 ;it:
+7 IF $DATA(^TIU(8925.1,PFILEDA,10,"B",FILEDA))
SET DUPANS=1
SET TIUFIMSG=" Please enter a different Name; Parent already has Item with that Name"
GOTO DUPX
+8 SET DUPANS=$$DUPITEM(NAME,PFILEDA,FILEDA)
DUPX QUIT DUPANS
+1 ;
EDTYPE(FILEDA,NODE0,PFILEDA,XFLG,USED) ; User edit FILEDA Type.
+1 ; Requires FILEDA, NODE0.
+2 ; Requires PFILEDA if DA has an actual/prospective parent. Need PFILEDA
+3 ;for add items/Create DDEF - they're not in AD xref because not items
+4 ;yet.
+5 ; Updates NODE0 (not the array, just the node).
+6 ; Returns XFLG=1 if user ^exited or timed out, else as received.
+7 ; Requires USED =1 for object or $$DDEFUSED^TIUFLF
+8 NEW TYPE,X,Y,NAME,TIUFTMSG,TIUFTLST,DEFLT,DIE,DR
+9 KILL DIRUT,DUOUT,DIROUT
+10 IF $PIECE(NODE0,U,4)="O"
WRITE !!,"TYPE: Object. Can't edit Type",!
GOTO EDTYX
+11 IF USED="YES"!(USED="ERROR")
WRITE !!,"TYPE: Entry In Use by Documents; Can't edit Type",!
GOTO EDTYX
+12 SET PFILEDA=+$GET(PFILEDA)
SET NAME=$PIECE(NODE0,U)
+13 DO TYPELIST(NAME,FILEDA,PFILEDA,.TIUFTMSG,.TIUFTLST)
if $DATA(DTOUT)
GOTO EDTYX
+14 IF $DATA(TIUFTMSG("T"))
WRITE !!,TIUFTMSG("T"),!,"Can't edit Type"
SET XFLG=1
DO PAUSE^TIUFXHLX
GOTO EDTYX
+15 IF $DATA(TIUFTMSG("R"))
IF $DATA(TIUFTMSG("R1"))
WRITE !!,TIUFTMSG("R"),!,TIUFTMSG("R1"),!
+16 IF $DATA(TIUFTMSG("O"))
if '$DATA(TIUFTMSG("R"))
WRITE !
WRITE TIUFTMSG("O"),!
+17 IF TIUFTLST=""
WRITE !!,"TYPE: ",$SELECT($DATA(TIUFTMSG):TIUFTMSG(1),1:" Faulty entry; File has entries of every permitted Type with the same Name"),!
DO PAUSE^TIUFXHLX
SET XFLG=1
GOTO EDTYX
+18 SET DEFLT=$PIECE(NODE0,U,4)
if $LENGTH(TIUFTLST,U)=3
SET DEFLT=$PIECE(TIUFTLST,U,2)
if DEFLT="DOC"
SET DEFLT="TL"
READTYP KILL DUOUT
SET TYPE=$SELECT(DEFLT'="":$$SELTYPE^TIUFLF8(FILEDA,DEFLT),1:$$SELTYPE^TIUFLF8(FILEDA))
+1 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO EDTYX
+2 IF TYPE=""
WRITE " ?? Enter appropriate Type or '^' to exit",!
HANG 2
GOTO READTYP
+3 if TYPE="TL"
SET TYPE="DOC"
SET DIE=8925.1
SET DR=".04////"_TYPE
DO ^DIE
+4 SET NODE0=^TIU(8925.1,FILEDA,0)
EDTYX if $DATA(DUOUT)!$DATA(DTOUT)
SET XFLG=1
+1 QUIT
+2 ;
DDEFIEN(TIUDEFNM,TIUTYPE) ; Function gets IEN (and more) of Doc Def
+1 ;Requires TIUDEFNM - .01 name of Title, Docmt Class or Class in
+2 ; the Document Definition file #8925.1
+3 ;Requires TIUTYPE - Expected type of DDEF: TL or DC or CL
+4 ;Returns IEN^STATUS^NATL if exactly one DDEF of type TIUTYPE
+5 ; is found
+6 ; or 0^ErrMsg
+7 ; NOTE: Only ONE DDEF of a given type is allowed in 8925.1.
+8 ; If DDEFs are created using TIU DDEF options, that is enforced.
+9 ; If DDEFs are created in a patch, the patch MUST
+10 ; enforce it.
+11 ;As a precaution, this module returns 0^ErrMsg if duplicates are found.
+12 ;However, TIU code ASSUMES there are no duplicates within a type.
+13 NEW TIUDEFDA,GOTIT,ERRMSG,TIUNODE0
+14 SET TIUTYPE=$GET(TIUTYPE)
+15 IF TIUTYPE'="TL"
IF TIUTYPE'="DC"
IF TIUTYPE'="CL"
QUIT "0^Type Required"
+16 IF TIUTYPE="TL"
SET TIUTYPE="DOC"
+17 SET TIUDEFDA=0
+18 ; -- Not in B xref:
+19 IF '$ORDER(^TIU(8925.1,"B",TIUDEFNM,0))
SET ERRMSG="0^Entry not found"
QUIT ERRMSG
+20 FOR
SET TIUDEFDA=+$ORDER(^TIU(8925.1,"B",TIUDEFNM,TIUDEFDA))
if TIUDEFDA'>0
QUIT
Begin DoDot:1
+21 SET TIUNODE0=$GET(^TIU(8925.1,TIUDEFDA,0))
+22 ; -- Not in file or not right type:
+23 IF $PIECE(TIUNODE0,U,4)'=TIUTYPE
QUIT
+24 ; -- Second good one:
+25 IF $DATA(GOTIT)
SET ERRMSG="0^Duplicates found"
QUIT
+26 ; -- First good one; set GOTIT=IEN^STATUS^NATL:
+27 SET GOTIT=TIUDEFDA_U_$PIECE(TIUNODE0,U,7)_U_$PIECE(TIUNODE0,U,13)
End DoDot:1
if $DATA(ERRMSG)
QUIT
+28 ; -- Not in B xref, or dups:
+29 IF $DATA(ERRMSG)
QUIT ERRMSG
+30 ; Good one w/o dups:
+31 IF $DATA(GOTIT)
QUIT GOTIT
+32 ; In B xref but not in file, or bad type:
+33 QUIT "0^Entry not found"
+34 ;
