TIUEDI1 ; SLC/MAM - Additional Edit Code ;March 25, 2004
;;1.0;TEXT INTEGRATION UTILITIES;**7,22,66,61,100,166**;Jun 20, 1997
GETREC(DFN,TIU,TIUCREAT,TIUNEW,TIUDPRM,TIUINQ,TIUPERSN) ;Returns
;new or existing document DA.
; Receives TIUPERSN (optional) = person asking to edit/create docmt,
; or for upload, = author of document.
; If not received, assumed to be DUZ.
; New **ID** parameter, backward compatible
; Requires array TIUTYP where
; TIUTYP = title DA
; TIUTYP(1) = 1^title DA^Name
; Receives TIUCREAT for backward compatibility place holder only
S TIUPERSN=$G(TIUPERSN,DUZ)
S DA=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.TIUNEW,.TIUDPRM,+$G(TIUINQ),TIUPERSN)
Q +$G(DA)
;
INQUIRE() ; Ask user whether to create a new note anyway
N TIUY,TIUPRMT
S TIUY=0,TIUPRMT="Do you want to create a new record anyway"
S TIUY=+$$READ^TIUU("Y",TIUPRMT,"NO")
Q TIUY
SCANDAD(TIUTYP,TIUDA) ; Search "DAD" index for component record
N TIUC,TIUY
S (TIUY,TIUC)=0
F S TIUC=$O(^TIU(8925,"DAD",+TIUDA,TIUC)) Q:+TIUC'>0!(+TIUY>0) D
. I +TIUTYP=+$G(^TIU(8925,+TIUC,0)) S TIUY=TIUC Q
. I +$O(^TIU(8925,"DAD",+TIUC,0)) S TIUY=$$SCANDAD(TIUTYP,TIUC)
Q TIUY
GETCOMP(TIUTYP,TIUDA,TIU,DFN) ; Adds components to document
N DIC,DA,X,Y,DIE,DR,TIUC,TIUCMP,TIUMOM,TIUMTYP,TIUY,TIUFPRIV
N DLAYGO ;10/3/00
S TIUFPRIV=1,(TIUY,TIUC)=0
S TIUY=$$SCANDAD(TIUTYP,TIUDA)
I +TIUY G GETCX
S (DIC,DLAYGO)=8925,DIC(0)="FL"
S X="""`"_+TIUTYP_""""
D ^DIC
I +Y'>0 W !,X," component could not be created.",! G GETCX
S (TIUY,DA)=+Y,DIE=DIC
S TIUMOM=+$$RUMYMTHR(TIUDA,DA,+TIUTYP,+$G(^TIU(8925,+DA,0)))
S TIUMTYP=+$G(^TIU(8925,+TIUMOM,0))
S DR=".02////"_DFN_";.03////"_$P($G(TIU("VISIT")),U)_";.04////"_TIUMTYP_";.06////"_TIUMOM
D ^DIE W "."
GETCX Q TIUY
RUMYMTHR(MOM,BRAT,MOMTYP,BRATYP) ; Get appropriate parent for component
N TIUI,GOTMOM,CNDMOM,CNDTYP,TIUMOM S (GOTMOM,TIUI)=0
I +$O(^TIU(8925.1,"AD",+BRATYP,MOMTYP,0)) S GOTMOM=1 G RUMYX
S CNDMOM=0
F S CNDMOM=$O(^TIU(8925,"DAD",+MOM,+CNDMOM)) Q:+CNDMOM'>0 D
. S CNDTYP=+$G(^TIU(8925,+CNDMOM,0))
. S TIUMOM=$$RUMYMTHR(CNDMOM,BRAT,CNDTYP,BRATYP) I $P(TIUMOM,U,2)=1 S MOM=+TIUMOM,GOTMOM=1 Q
RUMYX Q MOM_U_GOTMOM
DELCOMP(TIUDA) ; Cleans up all components of a document
N DA,DIE,DR,TIUCDA S TIUCDA=0,DIE="^TIU(8925,"
F S TIUCDA=$O(^TIU(8925,"DAD",TIUDA,TIUCDA)) Q:+TIUCDA'>0 D
. W !,$P(^TIU(8925.1,+^TIU(8925,TIUCDA,0),0),U)_" Component Deleted"
. S DR=".01///@",DA=TIUCDA D ^DIE W "."
. I +$O(^TIU(8925,"DAD",TIUCDA,0))>0 D DELCOMP(TIUCDA)
Q
DELAUDIT(TIUDA) ; Cleans up all AUDIT TRAIL entries for a document
N DA,DIK,DR,TIUADA S TIUADA=0,DIK="^TIU(8925.5,"
F S TIUADA=$O(^TIU(8925.5,"B",TIUDA,TIUADA)) Q:+TIUADA'>0 D
. ; W !," Audit trail record #",TIUADA," Deleted"
. S DA=TIUADA D ^DIK ; W "."
I $L($T(DEL^PXRMGECU)) D DEL^PXRMGECU(+TIUDA)
Q
ISCOMP(TIUTYP,X) ; Is the text provided a component tag
N DIC,TIULEVEL,TIUY,Y,TIUFPRIV S TIULEVEL=0,TIUFPRIV=1
S DIC=8925.1,DIC(0)="FX"
S DIC("S")="I $P(^TIU(8925.1,+Y,0),U,4)=""CO"""
D ^DIC K DIC("S")
I +Y'>0 S TIUY=0 G ISCMPX
I +$O(^TIU(8925.1,+TIUTYP,10,"B",+Y,0))'>0 S TIUY=0 G ISCMPX
S TIUY=Y
ISCMPX Q TIUY
MERGTEMP(TIUDA) ; Merge text from components into TEMP node for edit
N TIUC,TIUI,TIUJ,TIULINE
S (TIUC,TIULINE)=0,TIUJ=+$P($G(^TIU(8925,+TIUDA,"TEMP",0)),U,3)
F S TIUC=$O(^TIU(8925,"DAD",TIUDA,TIUC)) Q:+TIUC'>0 D
. I +$$ISADDNDM^TIULC1(+TIUC) Q
. S TIUI=0 F S TIUI=$O(^TIU(8925,+TIUC,"TEXT",TIUI)) Q:+TIUI'>0 D
. . S TIUJ=+$G(TIUJ)+1
. . S ^TIU(8925,+TIUDA,"TEMP",TIUJ,0)=$G(^TIU(8925,+TIUC,"TEXT",TIUI,0))
. . K ^TIU(8925,+TIUC,"TEXT",TIUI,0) ; Clear the way for edits
. . S ^TIU(8925,+TIUC,"TEXT",0)="^^^^"_DT_"^^"
. . S ^TIU(8925,+TIUDA,"TEMP",0)="^^"_TIUJ_"^"_TIUJ_"^"_DT_"^^"
. I +$O(^TIU(8925,"DAD",+TIUC,0)) D MERGGRAN(TIUDA,+TIUC)
. S TIUJ=+$P($G(^TIU(8925,+TIUDA,"TEMP",0)),U,3)
I $D(^TIU(8925,+TIUDA,"TEMP",1))>9 M ^TIU(8925,+TIUDA,"TEXT")=^TIU(8925,+TIUDA,"TEMP")
Q
MERGGRAN(TIUDA,TIUC) ; Merge sub-components into TEMP node of original
N TIUC1,TIUI,TIUJ,TIULINE
S (TIUC1,TIULINE)=0,TIUJ=+$P($G(^TIU(8925,+TIUDA,"TEMP",0)),U,3)
F S TIUC1=$O(^TIU(8925,"DAD",TIUC,TIUC1)) Q:+TIUC1'>0 D
. S TIUI=0 F S TIUI=$O(^TIU(8925,+TIUC1,"TEXT",TIUI)) Q:+TIUI'>0 D
. . S TIUJ=+$G(TIUJ)+1
. . S ^TIU(8925,+TIUDA,"TEMP",TIUJ,0)=$G(^TIU(8925,+TIUC1,"TEXT",TIUI,0))
. . K ^TIU(8925,+TIUC1,"TEXT",TIUI,0) ; Clear the way for edits
. . S ^TIU(8925,+TIUC1,"TEXT",0)="^^^^"_DT_"^^"
. . S ^TIU(8925,+TIUDA,"TEMP",0)="^^"_TIUJ_"^"_TIUJ_"^"_DT_"^^"
. I +$O(^TIU(8925,"DAD",+TIUC1,0)) D MERGGRAN(TIUDA,+TIUC1)
. S TIUJ=+$P($G(^TIU(8925,+TIUDA,"TEMP",0)),U,3)
Q
MERGTEXT(TIUDA,TIU) ; Merge TEMP node from parent document into components
N TIUTYP
S TIUTYP=+$P(^TIU(8925,+TIUDA,0),U)
; -- If document has components, add/update them
I +$O(^TIU(8925.1,+TIUTYP,10,0))>0 D
. N TIUC,TIUI,TIUJ,TIUX,TIUCMP S (TIUI,TIUJ,TIUCMP)=0
. F S TIUI=$O(^TIU(8925,+TIUDA,"TEMP",TIUI)) Q:+TIUI'>0 D
. . S TIUX=$G(^TIU(8925,+TIUDA,"TEMP",TIUI,0))
. . S TIUC=+$$ISCOMP(TIUTYP,$P(TIUX,":"))
. . I TIUX[":",+TIUC D
. . . S TIUJ=0 ; Reinitialize line count for new component
. . . S TIUCMP=$$GETCOMP(TIUC,TIUDA,.TIU,DFN)
. . S TIUJ=+$G(TIUJ)+1
. . I +TIUCMP>0 D
. . . S ^TIU(8925,+TIUCMP,"TEXT",TIUJ,0)=$G(^TIU(8925,+TIUDA,"TEMP",+TIUI,0))
. . . S ^TIU(8925,+TIUCMP,"TEXT",0)="^^"_TIUJ_"^"_TIUJ_"^"_DT_"^^"
. . E D
. . . S ^TIU(8925,+TIUDA,"TEXT",TIUJ,0)=$G(^TIU(8925,+TIUDA,"TEMP",TIUJ,0))
. . . S ^TIU(8925,+TIUDA,"TEXT",0)="^^"_TIUJ_"^"_TIUJ_"^"_DT_"^^"
; -- If no components, merge "TEMP" into "TEXT" for current document
I +$O(^TIU(8925.1,+TIUTYP,10,0))'>0 M ^TIU(8925,+TIUDA,"TEXT")=^TIU(8925,+TIUDA,"TEMP")
Q
GETTMPL(TIUTYP) ; Get edit template, enforce inheritance
N TIUDAD,TIUY S TIUDAD=0
S TIUY=$G(^TIU(8925.1,+TIUTYP,5))
I TIUY']"",($P(^TIU(8925.1,+TIUTYP,0),U)["ADDENDUM") D
. S TIUDAD=+$P($G(^TIU(8925,+$P($G(^TIU(8925,+$G(TIUDA),0)),U,6),0)),U)
. I +TIUDAD S TIUY=$$GETTMPL(TIUDAD)
I TIUY']"" S TIUDAD=$O(^TIU(8925.1,"AD",+TIUTYP,0))
I +TIUDAD S TIUY=$$GETTMPL(TIUDAD)
Q TIUY
AUDIT(TIUDA,TIUCKSM0,TIUCKSM1) ; Update audit trail
N DIC,DIE,DA,DR,X,Y
S X=""""_"`"_TIUDA_"""",(DIC,DLAYGO)=8925.5,DIC(0)="FLX" D ^DIC Q:+Y'>0
S DIE=DIC,DR=".02////"_$$NOW^TIULC_";.03////"_DUZ_";.04////"_TIUCKSM0_";.05////"_TIUCKSM1
S DA=+Y D ^DIE
Q
GETLMETH(TIUTYP) ; Get Visit Linkage method, enforce inheritance
N TIUDAD,TIUY S TIUDAD=0
S TIUY=$G(^TIU(8925.1,+TIUTYP,7))
I TIUY']"" S TIUDAD=$O(^TIU(8925.1,"AD",+TIUTYP,0))
I +TIUDAD S TIUY=$$GETLMETH(TIUDAD)
Q TIUY
GETVMETH(TIUTYP) ; Get Validation method, enforce enheritance
N TIUDAD,TIUY S TIUDAD=0
S TIUY=$G(^TIU(8925.1,+TIUTYP,8))
I TIUY']"" S TIUDAD=$O(^TIU(8925.1,"AD",+TIUTYP,0))
I +TIUDAD S TIUY=$$GETVMETH(TIUDAD)
Q TIUY
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUEDI1 6940 printed Dec 13, 2024@02:39:55 Page 2
TIUEDI1 ; SLC/MAM - Additional Edit Code ;March 25, 2004
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**7,22,66,61,100,166**;Jun 20, 1997
GETREC(DFN,TIU,TIUCREAT,TIUNEW,TIUDPRM,TIUINQ,TIUPERSN) ;Returns
+1 ;new or existing document DA.
+2 ; Receives TIUPERSN (optional) = person asking to edit/create docmt,
+3 ; or for upload, = author of document.
+4 ; If not received, assumed to be DUZ.
+5 ; New **ID** parameter, backward compatible
+6 ; Requires array TIUTYP where
+7 ; TIUTYP = title DA
+8 ; TIUTYP(1) = 1^title DA^Name
+9 ; Receives TIUCREAT for backward compatibility place holder only
+10 SET TIUPERSN=$GET(TIUPERSN,DUZ)
+11 SET DA=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.TIUNEW,.TIUDPRM,+$GET(TIUINQ),TIUPERSN)
+12 QUIT +$GET(DA)
+13 ;
INQUIRE() ; Ask user whether to create a new note anyway
+1 NEW TIUY,TIUPRMT
+2 SET TIUY=0
SET TIUPRMT="Do you want to create a new record anyway"
+3 SET TIUY=+$$READ^TIUU("Y",TIUPRMT,"NO")
+4 QUIT TIUY
SCANDAD(TIUTYP,TIUDA) ; Search "DAD" index for component record
+1 NEW TIUC,TIUY
+2 SET (TIUY,TIUC)=0
+3 FOR
SET TIUC=$ORDER(^TIU(8925,"DAD",+TIUDA,TIUC))
if +TIUC'>0!(+TIUY>0)
QUIT
Begin DoDot:1
+4 IF +TIUTYP=+$GET(^TIU(8925,+TIUC,0))
SET TIUY=TIUC
QUIT
+5 IF +$ORDER(^TIU(8925,"DAD",+TIUC,0))
SET TIUY=$$SCANDAD(TIUTYP,TIUC)
End DoDot:1
+6 QUIT TIUY
GETCOMP(TIUTYP,TIUDA,TIU,DFN) ; Adds components to document
+1 NEW DIC,DA,X,Y,DIE,DR,TIUC,TIUCMP,TIUMOM,TIUMTYP,TIUY,TIUFPRIV
+2 ;10/3/00
NEW DLAYGO
+3 SET TIUFPRIV=1
SET (TIUY,TIUC)=0
+4 SET TIUY=$$SCANDAD(TIUTYP,TIUDA)
+5 IF +TIUY
GOTO GETCX
+6 SET (DIC,DLAYGO)=8925
SET DIC(0)="FL"
+7 SET X="""`"_+TIUTYP_""""
+8 DO ^DIC
+9 IF +Y'>0
WRITE !,X," component could not be created.",!
GOTO GETCX
+10 SET (TIUY,DA)=+Y
SET DIE=DIC
+11 SET TIUMOM=+$$RUMYMTHR(TIUDA,DA,+TIUTYP,+$GET(^TIU(8925,+DA,0)))
+12 SET TIUMTYP=+$GET(^TIU(8925,+TIUMOM,0))
+13 SET DR=".02////"_DFN_";.03////"_$PIECE($GET(TIU("VISIT")),U)_";.04////"_TIUMTYP_";.06////"_TIUMOM
+14 DO ^DIE
WRITE "."
GETCX QUIT TIUY
RUMYMTHR(MOM,BRAT,MOMTYP,BRATYP) ; Get appropriate parent for component
+1 NEW TIUI,GOTMOM,CNDMOM,CNDTYP,TIUMOM
SET (GOTMOM,TIUI)=0
+2 IF +$ORDER(^TIU(8925.1,"AD",+BRATYP,MOMTYP,0))
SET GOTMOM=1
GOTO RUMYX
+3 SET CNDMOM=0
+4 FOR
SET CNDMOM=$ORDER(^TIU(8925,"DAD",+MOM,+CNDMOM))
if +CNDMOM'>0
QUIT
Begin DoDot:1
+5 SET CNDTYP=+$GET(^TIU(8925,+CNDMOM,0))
+6 SET TIUMOM=$$RUMYMTHR(CNDMOM,BRAT,CNDTYP,BRATYP)
IF $PIECE(TIUMOM,U,2)=1
SET MOM=+TIUMOM
SET GOTMOM=1
QUIT
End DoDot:1
RUMYX QUIT MOM_U_GOTMOM
DELCOMP(TIUDA) ; Cleans up all components of a document
+1 NEW DA,DIE,DR,TIUCDA
SET TIUCDA=0
SET DIE="^TIU(8925,"
+2 FOR
SET TIUCDA=$ORDER(^TIU(8925,"DAD",TIUDA,TIUCDA))
if +TIUCDA'>0
QUIT
Begin DoDot:1
+3 WRITE !,$PIECE(^TIU(8925.1,+^TIU(8925,TIUCDA,0),0),U)_" Component Deleted"
+4 SET DR=".01///@"
SET DA=TIUCDA
DO ^DIE
WRITE "."
+5 IF +$ORDER(^TIU(8925,"DAD",TIUCDA,0))>0
DO DELCOMP(TIUCDA)
End DoDot:1
+6 QUIT
DELAUDIT(TIUDA) ; Cleans up all AUDIT TRAIL entries for a document
+1 NEW DA,DIK,DR,TIUADA
SET TIUADA=0
SET DIK="^TIU(8925.5,"
+2 FOR
SET TIUADA=$ORDER(^TIU(8925.5,"B",TIUDA,TIUADA))
if +TIUADA'>0
QUIT
Begin DoDot:1
+3 ; W !," Audit trail record #",TIUADA," Deleted"
+4 ; W "."
SET DA=TIUADA
DO ^DIK
End DoDot:1
+5 IF $LENGTH($TEXT(DEL^PXRMGECU))
DO DEL^PXRMGECU(+TIUDA)
+6 QUIT
ISCOMP(TIUTYP,X) ; Is the text provided a component tag
+1 NEW DIC,TIULEVEL,TIUY,Y,TIUFPRIV
SET TIULEVEL=0
SET TIUFPRIV=1
+2 SET DIC=8925.1
SET DIC(0)="FX"
+3 SET DIC("S")="I $P(^TIU(8925.1,+Y,0),U,4)=""CO"""
+4 DO ^DIC
KILL DIC("S")
+5 IF +Y'>0
SET TIUY=0
GOTO ISCMPX
+6 IF +$ORDER(^TIU(8925.1,+TIUTYP,10,"B",+Y,0))'>0
SET TIUY=0
GOTO ISCMPX
+7 SET TIUY=Y
ISCMPX QUIT TIUY
MERGTEMP(TIUDA) ; Merge text from components into TEMP node for edit
+1 NEW TIUC,TIUI,TIUJ,TIULINE
+2 SET (TIUC,TIULINE)=0
SET TIUJ=+$PIECE($GET(^TIU(8925,+TIUDA,"TEMP",0)),U,3)
+3 FOR
SET TIUC=$ORDER(^TIU(8925,"DAD",TIUDA,TIUC))
if +TIUC'>0
QUIT
Begin DoDot:1
+4 IF +$$ISADDNDM^TIULC1(+TIUC)
QUIT
+5 SET TIUI=0
FOR
SET TIUI=$ORDER(^TIU(8925,+TIUC,"TEXT",TIUI))
if +TIUI'>0
QUIT
Begin DoDot:2
+6 SET TIUJ=+$GET(TIUJ)+1
+7 SET ^TIU(8925,+TIUDA,"TEMP",TIUJ,0)=$GET(^TIU(8925,+TIUC,"TEXT",TIUI,0))
+8 ; Clear the way for edits
KILL ^TIU(8925,+TIUC,"TEXT",TIUI,0)
+9 SET ^TIU(8925,+TIUC,"TEXT",0)="^^^^"_DT_"^^"
+10 SET ^TIU(8925,+TIUDA,"TEMP",0)="^^"_TIUJ_"^"_TIUJ_"^"_DT_"^^"
End DoDot:2
+11 IF +$ORDER(^TIU(8925,"DAD",+TIUC,0))
DO MERGGRAN(TIUDA,+TIUC)
+12 SET TIUJ=+$PIECE($GET(^TIU(8925,+TIUDA,"TEMP",0)),U,3)
End DoDot:1
+13 IF $DATA(^TIU(8925,+TIUDA,"TEMP",1))>9
MERGE ^TIU(8925,+TIUDA,"TEXT")=^TIU(8925,+TIUDA,"TEMP")
+14 QUIT
MERGGRAN(TIUDA,TIUC) ; Merge sub-components into TEMP node of original
+1 NEW TIUC1,TIUI,TIUJ,TIULINE
+2 SET (TIUC1,TIULINE)=0
SET TIUJ=+$PIECE($GET(^TIU(8925,+TIUDA,"TEMP",0)),U,3)
+3 FOR
SET TIUC1=$ORDER(^TIU(8925,"DAD",TIUC,TIUC1))
if +TIUC1'>0
QUIT
Begin DoDot:1
+4 SET TIUI=0
FOR
SET TIUI=$ORDER(^TIU(8925,+TIUC1,"TEXT",TIUI))
if +TIUI'>0
QUIT
Begin DoDot:2
+5 SET TIUJ=+$GET(TIUJ)+1
+6 SET ^TIU(8925,+TIUDA,"TEMP",TIUJ,0)=$GET(^TIU(8925,+TIUC1,"TEXT",TIUI,0))
+7 ; Clear the way for edits
KILL ^TIU(8925,+TIUC1,"TEXT",TIUI,0)
+8 SET ^TIU(8925,+TIUC1,"TEXT",0)="^^^^"_DT_"^^"
+9 SET ^TIU(8925,+TIUDA,"TEMP",0)="^^"_TIUJ_"^"_TIUJ_"^"_DT_"^^"
End DoDot:2
+10 IF +$ORDER(^TIU(8925,"DAD",+TIUC1,0))
DO MERGGRAN(TIUDA,+TIUC1)
+11 SET TIUJ=+$PIECE($GET(^TIU(8925,+TIUDA,"TEMP",0)),U,3)
End DoDot:1
+12 QUIT
MERGTEXT(TIUDA,TIU) ; Merge TEMP node from parent document into components
+1 NEW TIUTYP
+2 SET TIUTYP=+$PIECE(^TIU(8925,+TIUDA,0),U)
+3 ; -- If document has components, add/update them
+4 IF +$ORDER(^TIU(8925.1,+TIUTYP,10,0))>0
Begin DoDot:1
+5 NEW TIUC,TIUI,TIUJ,TIUX,TIUCMP
SET (TIUI,TIUJ,TIUCMP)=0
+6 FOR
SET TIUI=$ORDER(^TIU(8925,+TIUDA,"TEMP",TIUI))
if +TIUI'>0
QUIT
Begin DoDot:2
+7 SET TIUX=$GET(^TIU(8925,+TIUDA,"TEMP",TIUI,0))
+8 SET TIUC=+$$ISCOMP(TIUTYP,$PIECE(TIUX,":"))
+9 IF TIUX[":"
IF +TIUC
Begin DoDot:3
+10 ; Reinitialize line count for new component
SET TIUJ=0
+11 SET TIUCMP=$$GETCOMP(TIUC,TIUDA,.TIU,DFN)
End DoDot:3
+12 SET TIUJ=+$GET(TIUJ)+1
+13 IF +TIUCMP>0
Begin DoDot:3
+14 SET ^TIU(8925,+TIUCMP,"TEXT",TIUJ,0)=$GET(^TIU(8925,+TIUDA,"TEMP",+TIUI,0))
+15 SET ^TIU(8925,+TIUCMP,"TEXT",0)="^^"_TIUJ_"^"_TIUJ_"^"_DT_"^^"
End DoDot:3
+16 IF '$TEST
Begin DoDot:3
+17 SET ^TIU(8925,+TIUDA,"TEXT",TIUJ,0)=$GET(^TIU(8925,+TIUDA,"TEMP",TIUJ,0))
+18 SET ^TIU(8925,+TIUDA,"TEXT",0)="^^"_TIUJ_"^"_TIUJ_"^"_DT_"^^"
End DoDot:3
End DoDot:2
End DoDot:1
+19 ; -- If no components, merge "TEMP" into "TEXT" for current document
+20 IF +$ORDER(^TIU(8925.1,+TIUTYP,10,0))'>0
MERGE ^TIU(8925,+TIUDA,"TEXT")=^TIU(8925,+TIUDA,"TEMP")
+21 QUIT
GETTMPL(TIUTYP) ; Get edit template, enforce inheritance
+1 NEW TIUDAD,TIUY
SET TIUDAD=0
+2 SET TIUY=$GET(^TIU(8925.1,+TIUTYP,5))
+3 IF TIUY']""
IF ($PIECE(^TIU(8925.1,+TIUTYP,0),U)["ADDENDUM")
Begin DoDot:1
+4 SET TIUDAD=+$PIECE($GET(^TIU(8925,+$PIECE($GET(^TIU(8925,+$GET(TIUDA),0)),U,6),0)),U)
+5 IF +TIUDAD
SET TIUY=$$GETTMPL(TIUDAD)
End DoDot:1
+6 IF TIUY']""
SET TIUDAD=$ORDER(^TIU(8925.1,"AD",+TIUTYP,0))
+7 IF +TIUDAD
SET TIUY=$$GETTMPL(TIUDAD)
+8 QUIT TIUY
AUDIT(TIUDA,TIUCKSM0,TIUCKSM1) ; Update audit trail
+1 NEW DIC,DIE,DA,DR,X,Y
+2 SET X=""""_"`"_TIUDA_""""
SET (DIC,DLAYGO)=8925.5
SET DIC(0)="FLX"
DO ^DIC
if +Y'>0
QUIT
+3 SET DIE=DIC
SET DR=".02////"_$$NOW^TIULC_";.03////"_DUZ_";.04////"_TIUCKSM0_";.05////"_TIUCKSM1
+4 SET DA=+Y
DO ^DIE
+5 QUIT
GETLMETH(TIUTYP) ; Get Visit Linkage method, enforce inheritance
+1 NEW TIUDAD,TIUY
SET TIUDAD=0
+2 SET TIUY=$GET(^TIU(8925.1,+TIUTYP,7))
+3 IF TIUY']""
SET TIUDAD=$ORDER(^TIU(8925.1,"AD",+TIUTYP,0))
+4 IF +TIUDAD
SET TIUY=$$GETLMETH(TIUDAD)
+5 QUIT TIUY
GETVMETH(TIUTYP) ; Get Validation method, enforce enheritance
+1 NEW TIUDAD,TIUY
SET TIUDAD=0
+2 SET TIUY=$GET(^TIU(8925.1,+TIUTYP,8))
+3 IF TIUY']""
SET TIUDAD=$ORDER(^TIU(8925.1,"AD",+TIUTYP,0))
+4 IF +TIUDAD
SET TIUY=$$GETVMETH(TIUDAD)
+5 QUIT TIUY
+6 ;
