TIURECL1 ; SLC/PKR,JER - Expand/collapse LM views ;5/8/03
;;1.0;TEXT INTEGRATION UTILITIES;**100,113**;Jun 20, 1997
; 7/6 Split TIURECL into TIURECL & TIURECL1, move RESOLVE to TIURECL1
; 7/10 Move INSID, INSADD, VEXREQ, ISSUB to TIURECL1
; 9/7 Move INSKIDS, INSADD, & associated modules to TIURECL2
;=======================================================================
ISSUB(CLASS1,CLASS2,LEVEL) ;Return true if CLASS2 is sub to CLASS1.
N IND,ISSUB
I LEVEL(CLASS1)'<LEVEL(CLASS2) Q 0
;Check sublevel links between class1 and class2
S ISSUB=1
F IND=(CLASS1+1):1:(CLASS2-1) D
. I LEVEL(IND)=1 D Q
.. S ISSUB=0
Q ISSUB
;
;======================================================================
VEXREQ(VALMY) ;Check for valid expand/contract requests.
; A list of documents to expand/contract is invalid if any docmt
;is a sub docmt of another docmt on the list.
N END,START
S START=$O(VALMY(""))
S END=$O(VALMY(""),-1)
I START=END Q 1
;
N ACTION,ACTIND,ACTJND,CIND,CN,IND,JND,LEVEL,MSG,TEXT,VALID
;Build the level list.
F IND=START:1:END D
. S LEVEL(IND)=$L(@VALMAR@(IND,0),"|")
S VALID=1
S IND=""
F S IND=$O(VALMY(IND)) Q:+IND'>0 D
. S TEXT(IND)=$G(@VALMAR@(IND,0))
. S ACTIND=$S(TEXT(IND)["+":"+ ",TEXT(IND)["-":"-",1:"")
. I ACTIND="" Q
. S ACTION(IND)=$S(TEXT(IND)["+":"expand ",TEXT(IND)["-":"collapse ",1:"")
. S JND=IND
. F S JND=$O(VALMY(JND)) Q:+JND'>0 D
.. S TEXT(JND)=$G(@VALMAR@(JND,0))
.. S ACTJND=$S(TEXT(JND)["+":"+",TEXT(JND)["-":"-",1:"")
.. I ACTJND="" Q
.. S ACTION(JND)=$S(TEXT(JND)["+":"expand ",TEXT(JND)["-":"collapse ",1:"")
.. I $$ISSUB(IND,JND,.LEVEL) D
... I ACTION(IND)'=ACTION(JND) D Q
.... S CIND(IND)=$P(^TMP("TIURIDX",$J,IND),U,2)
.... S CN(IND)=$P(^TIU(8925,CIND(IND),0),U,1)
.... S CIND(JND)=$P(^TMP("TIURIDX",$J,JND),U,2)
.... S CN(JND)=$P(^TIU(8925,CIND(JND),0),U,1)
.... I '+$G(HUSH) D
..... S MSG="You cannot "_ACTION(IND)_CN(IND)_" and "_ACTION(JND)_CN(JND)
..... D MSG^VALM10(MSG)
..... H 4
.... S VALID=0
Q VALID
;======================================================================
IDDATA(TIUDA,TIUD0,TIUD21) ; Return TIUGDATA:
; TIUGDATA = 0 or
; = TIUDA^haskid^IDparent^prmsort, where
; TIUDA = note DA
; haskid = 1 if note has ID kid, else 0
; IDparent = parent DA if note has ID parent, else 0
; prmsort = 'TITLE' if entries ordered by title, else 'REFDT'
;Note: TIUGDATA is nonzero if note is POSSIBLE DAD, or dad, or kid.
; Requires TIUDA; TIUD0 & TIUD21 are optional
N HASIDKID,POSSPRNT,TIUDPRM,PRMSORT,TIUGDATA
I '$G(TIUD0) S TIUD0=^TIU(8925,TIUDA,0)
I '$D(TIUD21) S TIUD21=+$G(^TIU(8925,TIUDA,21))
S (TIUGDATA,POSSPRNT)=0
S HASIDKID=$$HASIDKID^TIUGBR(TIUDA)
I 'TIUD21,'HASIDKID S POSSPRNT=$$POSSPRNT^TIULP(+TIUD0) ;has bus rules
I TIUD21!HASIDKID!POSSPRNT D
. I 'TIUD21 D I 1
. . D DOCPRM^TIULC1(+TIUD0,.TIUDPRM)
. . S PRMSORT=$S($P($G(TIUDPRM(0)),U,18):"TITLE",1:"REFDT")
. E S PRMSORT=""
. S TIUGDATA=TIUDA_U_HASIDKID_U_TIUD21_U_PRMSORT
Q TIUGDATA
;
RESOLVE(DA,TSTART,FIRSTPFX,XIDDATA) ; Get document data for insertion
; Receives DA, TSTART, FIRSTPFX
; FIRSTPFX = $$INSPFIX of parent of inserted document.
; Returns line TSTART.
; Receives XIDDATA by ref, finds it, and passes it back.
N DIC,DIQ,DR,TIUR,PT,MOM,ADT,DDT,LCT,AUT,AMD,EDT,SDT,XDT,RMD,TIULST4
N TIUP,TIUD0,TIUD12,TIUD13,TIUD15,TIULI,STATX,DOC,TIUY,TIUI,TIUFLDS
N PREFIX,GETTL,GETPT,TIUD21,INSTA,TIUSTN
I '$D(^TIU(8925,DA,0)) S TIUY="Record #"_DA_" is missing." G RESOLVEX
S TIUD0=$G(^TIU(8925,+DA,0)),TIUD12=$G(^TIU(8925,+DA,12))
S TIUD13=$G(^TIU(8925,+DA,13)),TIUD15=$G(^TIU(8925,+DA,15))
S TIUD21=$G(^TIU(8925,+DA,21))
S XIDDATA=$$IDDATA(DA,TIUD0,TIUD21)
S PREFIX=$$PREFIX^TIULA2(DA),PREFIX=FIRSTPFX_PREFIX
S GETTL=$$GETTL(TIUD0,PREFIX)
; Most screens have docmt title in 1st column, but some have pat nm:
S DOC=$S($D(VALMDDF("PATIENT NAME")):$P(GETTL,U),1:$P(GETTL,U,2)_$P(GETTL,U))
S TIUFLDS("DOCUMENT TYPE")="DOC"
S TIUFLDS("TITLE")="DOC"
S GETPT=$$GETPT(TIUD0,PREFIX)
S TIULI=$E(GETPT)
S PT=$P(GETPT,U,2)_$P(GETPT,U)
S TIUFLDS("PATIENT NAME")="PT"
S TIULST4=$E($P($G(^DPT(+$P(TIUD0,U,2),0)),U,9),6,9)
S TIULST4="("_TIULI_TIULST4_")"
S TIUFLDS("LAST I/LAST 4")="TIULST4"
S ADT=$$DATE^TIULS($P(TIUD0,U,7),"MM/DD/YY")
S TIUFLDS("ADMISSION DATE")="ADT"
S DDT=$$DATE^TIULS($P(TIUD0,U,8),"MM/DD/YY"),LCT=$P(TIUD0,U,10)
S TIUFLDS("DISCH DATE")="DDT"
S TIUFLDS("LINE COUNT")="AMD"
S AMD=$$PERSNAME^TIULC1($P(TIUD12,U,8)) S:AMD="UNKNOWN" AMD=""
S AUT=$$PERSNAME^TIULC1($P(TIUD12,U,2)) S:AUT="UNKNOWN" AUT=""
S AMD=$$NAME^TIULS(AMD,"LAST, FI MI")
S TIUFLDS("ATTENDING")="AMD"
S TIUFLDS("COSIGNER")="AMD"
I $D(^TMP("TIUR",$J,"CTXT")) S AUT=$$NAME^TIULS(AUT,"LAST,FI") I 1
E S AUT=$$NAME^TIULS(AUT,"LAST, FI MI")
S TIUFLDS("AUTHOR")="AUT"
I $D(^TMP("TIUR",$J,"CTXT")) S EDT=$$DATE^TIULS($P(TIUD13,U),"MM/DD/YY HR:MIN") I 1
E S EDT=$$DATE^TIULS($P(TIUD13,U),"MM/DD/YY")
S TIUFLDS("REF DATE")="EDT"
S XDT=$$DATE^TIULS($P(TIUD13,U,7),"MM/DD/YY")
S TIUFLDS("DICT DATE")="XDT"
S SDT=$S(+$P(TIUD15,U,7):+$P(TIUD15,U,7),+$P(TIUD0,U,5)'<7:+$P(TIUD15,U),1:"")
S SDT=$$DATE^TIULS(SDT,"MM/DD/YY")
S TIUFLDS("SIG DATE")="SDT"
S STATX=$$LOW^XLFSTR($P($G(^TIU(8925.6,+$P(TIUD0,U,5),0)),U))
S TIUFLDS("STATUS")="STATX"
S INSTA=""
I +$P(TIUD12,U,12)>0 D
. S TIUSTN=$$NS^XUAF4($P(TIUD12,U,12))
. I $P(TIUSTN,U,2)]"" S INSTA=$P(TIUSTN,U,2)
S INSTA=$E(INSTA,1,8)
S TIUFLDS("DIVISION")="INSTA"
S (TIUI,TIUY)=""
S TIUY=$$SETFLD^VALM1(TSTART,TIUY,"NUMBER")
F S TIUI=$O(TIUFLDS(TIUI)) Q:TIUI="" D
. S:$D(VALMDDF(TIUI)) TIUY=$$SETFLD^VALM1(@TIUFLDS(TIUI),TIUY,TIUI)
RESOLVEX Q TIUY
;
GETPT(TIUD0,PREFIX) ; Get patient column data; put updated prefix data
;in second ^ piece
; Receives TIUDO, PREFIX.
; Returns (patient col data)^PREFIX
N TIUY
S TIUY=$$NAME^TIULS($$PTNAME^TIULC1($P(TIUD0,U,2)),"LAST,FI MI")
I $D(PREFIX) S TIUY=TIUY_U_PREFIX
Q TIUY
;
GETTL(TIUD0,PREFIX) ; Get title column data; put updated prefix
;data in second ^ piece.
; Receives TIUDO, PREFIX.
; Returns (title col data)^PREFIX
N TIUY
S TIUY=$$PNAME^TIULC1(+TIUD0)
I TIUY="Addendum" S TIUY="Addendum to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUD0,U,6),0)))
I $D(PREFIX) S TIUY=TIUY_U_PREFIX
Q TIUY
;
SETTLPT(STRING,DA,PREFIX) ; Set field TITLE or PATIENT into string,
;with prefix as first chars of string.
; Receives STRING, DA, PREFIX:
; PREFIX = beginning chars of title/pt column, up to but not
; including title/pt itself.
; Returns STRING.
N PT,DOC,TIUD0
S TIUD0=^TIU(8925,DA,0)
I $D(VALMDDF("PATIENT NAME")) D I 1
. S PT=$$GETPT(TIUD0,PREFIX)
. S PT=$P(PT,U,2)_$P(PT,U)
. S STRING=$$SETFLD^VALM1(PT,STRING,"PATIENT NAME")
E D
. S DOC=$$GETTL(TIUD0,PREFIX)
. S DOC=$P(DOC,U,2)_$P(DOC,U)
. S STRING=$$SETFLD^VALM1(DOC,STRING,"TITLE")
Q STRING
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURECL1 7028 printed Dec 13, 2024@02:45:15 Page 2
TIURECL1 ; SLC/PKR,JER - Expand/collapse LM views ;5/8/03
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**100,113**;Jun 20, 1997
+2 ; 7/6 Split TIURECL into TIURECL & TIURECL1, move RESOLVE to TIURECL1
+3 ; 7/10 Move INSID, INSADD, VEXREQ, ISSUB to TIURECL1
+4 ; 9/7 Move INSKIDS, INSADD, & associated modules to TIURECL2
+5 ;=======================================================================
ISSUB(CLASS1,CLASS2,LEVEL) ;Return true if CLASS2 is sub to CLASS1.
+1 NEW IND,ISSUB
+2 IF LEVEL(CLASS1)'<LEVEL(CLASS2)
QUIT 0
+3 ;Check sublevel links between class1 and class2
+4 SET ISSUB=1
+5 FOR IND=(CLASS1+1):1:(CLASS2-1)
Begin DoDot:1
+6 IF LEVEL(IND)=1
Begin DoDot:2
+7 SET ISSUB=0
End DoDot:2
QUIT
End DoDot:1
+8 QUIT ISSUB
+9 ;
+10 ;======================================================================
VEXREQ(VALMY) ;Check for valid expand/contract requests.
+1 ; A list of documents to expand/contract is invalid if any docmt
+2 ;is a sub docmt of another docmt on the list.
+3 NEW END,START
+4 SET START=$ORDER(VALMY(""))
+5 SET END=$ORDER(VALMY(""),-1)
+6 IF START=END
QUIT 1
+7 ;
+8 NEW ACTION,ACTIND,ACTJND,CIND,CN,IND,JND,LEVEL,MSG,TEXT,VALID
+9 ;Build the level list.
+10 FOR IND=START:1:END
Begin DoDot:1
+11 SET LEVEL(IND)=$LENGTH(@VALMAR@(IND,0),"|")
End DoDot:1
+12 SET VALID=1
+13 SET IND=""
+14 FOR
SET IND=$ORDER(VALMY(IND))
if +IND'>0
QUIT
Begin DoDot:1
+15 SET TEXT(IND)=$GET(@VALMAR@(IND,0))
+16 SET ACTIND=$SELECT(TEXT(IND)["+":"+ ",TEXT(IND)["-":"-",1:"")
+17 IF ACTIND=""
QUIT
+18 SET ACTION(IND)=$SELECT(TEXT(IND)["+":"expand ",TEXT(IND)["-":"collapse ",1:"")
+19 SET JND=IND
+20 FOR
SET JND=$ORDER(VALMY(JND))
if +JND'>0
QUIT
Begin DoDot:2
+21 SET TEXT(JND)=$GET(@VALMAR@(JND,0))
+22 SET ACTJND=$SELECT(TEXT(JND)["+":"+",TEXT(JND)["-":"-",1:"")
+23 IF ACTJND=""
QUIT
+24 SET ACTION(JND)=$SELECT(TEXT(JND)["+":"expand ",TEXT(JND)["-":"collapse ",1:"")
+25 IF $$ISSUB(IND,JND,.LEVEL)
Begin DoDot:3
+26 IF ACTION(IND)'=ACTION(JND)
Begin DoDot:4
+27 SET CIND(IND)=$PIECE(^TMP("TIURIDX",$JOB,IND),U,2)
+28 SET CN(IND)=$PIECE(^TIU(8925,CIND(IND),0),U,1)
+29 SET CIND(JND)=$PIECE(^TMP("TIURIDX",$JOB,JND),U,2)
+30 SET CN(JND)=$PIECE(^TIU(8925,CIND(JND),0),U,1)
+31 IF '+$GET(HUSH)
Begin DoDot:5
+32 SET MSG="You cannot "_ACTION(IND)_CN(IND)_" and "_ACTION(JND)_CN(JND)
+33 DO MSG^VALM10(MSG)
+34 HANG 4
End DoDot:5
+35 SET VALID=0
End DoDot:4
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+36 QUIT VALID
+37 ;======================================================================
IDDATA(TIUDA,TIUD0,TIUD21) ; Return TIUGDATA:
+1 ; TIUGDATA = 0 or
+2 ; = TIUDA^haskid^IDparent^prmsort, where
+3 ; TIUDA = note DA
+4 ; haskid = 1 if note has ID kid, else 0
+5 ; IDparent = parent DA if note has ID parent, else 0
+6 ; prmsort = 'TITLE' if entries ordered by title, else 'REFDT'
+7 ;Note: TIUGDATA is nonzero if note is POSSIBLE DAD, or dad, or kid.
+8 ; Requires TIUDA; TIUD0 & TIUD21 are optional
+9 NEW HASIDKID,POSSPRNT,TIUDPRM,PRMSORT,TIUGDATA
+10 IF '$GET(TIUD0)
SET TIUD0=^TIU(8925,TIUDA,0)
+11 IF '$DATA(TIUD21)
SET TIUD21=+$GET(^TIU(8925,TIUDA,21))
+12 SET (TIUGDATA,POSSPRNT)=0
+13 SET HASIDKID=$$HASIDKID^TIUGBR(TIUDA)
+14 ;has bus rules
IF 'TIUD21
IF 'HASIDKID
SET POSSPRNT=$$POSSPRNT^TIULP(+TIUD0)
+15 IF TIUD21!HASIDKID!POSSPRNT
Begin DoDot:1
+16 IF 'TIUD21
Begin DoDot:2
+17 DO DOCPRM^TIULC1(+TIUD0,.TIUDPRM)
+18 SET PRMSORT=$SELECT($PIECE($GET(TIUDPRM(0)),U,18):"TITLE",1:"REFDT")
End DoDot:2
IF 1
+19 IF '$TEST
SET PRMSORT=""
+20 SET TIUGDATA=TIUDA_U_HASIDKID_U_TIUD21_U_PRMSORT
End DoDot:1
+21 QUIT TIUGDATA
+22 ;
RESOLVE(DA,TSTART,FIRSTPFX,XIDDATA) ; Get document data for insertion
+1 ; Receives DA, TSTART, FIRSTPFX
+2 ; FIRSTPFX = $$INSPFIX of parent of inserted document.
+3 ; Returns line TSTART.
+4 ; Receives XIDDATA by ref, finds it, and passes it back.
+5 NEW DIC,DIQ,DR,TIUR,PT,MOM,ADT,DDT,LCT,AUT,AMD,EDT,SDT,XDT,RMD,TIULST4
+6 NEW TIUP,TIUD0,TIUD12,TIUD13,TIUD15,TIULI,STATX,DOC,TIUY,TIUI,TIUFLDS
+7 NEW PREFIX,GETTL,GETPT,TIUD21,INSTA,TIUSTN
+8 IF '$DATA(^TIU(8925,DA,0))
SET TIUY="Record #"_DA_" is missing."
GOTO RESOLVEX
+9 SET TIUD0=$GET(^TIU(8925,+DA,0))
SET TIUD12=$GET(^TIU(8925,+DA,12))
+10 SET TIUD13=$GET(^TIU(8925,+DA,13))
SET TIUD15=$GET(^TIU(8925,+DA,15))
+11 SET TIUD21=$GET(^TIU(8925,+DA,21))
+12 SET XIDDATA=$$IDDATA(DA,TIUD0,TIUD21)
+13 SET PREFIX=$$PREFIX^TIULA2(DA)
SET PREFIX=FIRSTPFX_PREFIX
+14 SET GETTL=$$GETTL(TIUD0,PREFIX)
+15 ; Most screens have docmt title in 1st column, but some have pat nm:
+16 SET DOC=$SELECT($DATA(VALMDDF("PATIENT NAME")):$PIECE(GETTL,U),1:$PIECE(GETTL,U,2)_$PIECE(GETTL,U))
+17 SET TIUFLDS("DOCUMENT TYPE")="DOC"
+18 SET TIUFLDS("TITLE")="DOC"
+19 SET GETPT=$$GETPT(TIUD0,PREFIX)
+20 SET TIULI=$EXTRACT(GETPT)
+21 SET PT=$PIECE(GETPT,U,2)_$PIECE(GETPT,U)
+22 SET TIUFLDS("PATIENT NAME")="PT"
+23 SET TIULST4=$EXTRACT($PIECE($GET(^DPT(+$PIECE(TIUD0,U,2),0)),U,9),6,9)
+24 SET TIULST4="("_TIULI_TIULST4_")"
+25 SET TIUFLDS("LAST I/LAST 4")="TIULST4"
+26 SET ADT=$$DATE^TIULS($PIECE(TIUD0,U,7),"MM/DD/YY")
+27 SET TIUFLDS("ADMISSION DATE")="ADT"
+28 SET DDT=$$DATE^TIULS($PIECE(TIUD0,U,8),"MM/DD/YY")
SET LCT=$PIECE(TIUD0,U,10)
+29 SET TIUFLDS("DISCH DATE")="DDT"
+30 SET TIUFLDS("LINE COUNT")="AMD"
+31 SET AMD=$$PERSNAME^TIULC1($PIECE(TIUD12,U,8))
if AMD="UNKNOWN"
SET AMD=""
+32 SET AUT=$$PERSNAME^TIULC1($PIECE(TIUD12,U,2))
if AUT="UNKNOWN"
SET AUT=""
+33 SET AMD=$$NAME^TIULS(AMD,"LAST, FI MI")
+34 SET TIUFLDS("ATTENDING")="AMD"
+35 SET TIUFLDS("COSIGNER")="AMD"
+36 IF $DATA(^TMP("TIUR",$JOB,"CTXT"))
SET AUT=$$NAME^TIULS(AUT,"LAST,FI")
IF 1
+37 IF '$TEST
SET AUT=$$NAME^TIULS(AUT,"LAST, FI MI")
+38 SET TIUFLDS("AUTHOR")="AUT"
+39 IF $DATA(^TMP("TIUR",$JOB,"CTXT"))
SET EDT=$$DATE^TIULS($PIECE(TIUD13,U),"MM/DD/YY HR:MIN")
IF 1
+40 IF '$TEST
SET EDT=$$DATE^TIULS($PIECE(TIUD13,U),"MM/DD/YY")
+41 SET TIUFLDS("REF DATE")="EDT"
+42 SET XDT=$$DATE^TIULS($PIECE(TIUD13,U,7),"MM/DD/YY")
+43 SET TIUFLDS("DICT DATE")="XDT"
+44 SET SDT=$SELECT(+$PIECE(TIUD15,U,7):+$PIECE(TIUD15,U,7),+$PIECE(TIUD0,U,5)'<7:+$PIECE(TIUD15,U),1:"")
+45 SET SDT=$$DATE^TIULS(SDT,"MM/DD/YY")
+46 SET TIUFLDS("SIG DATE")="SDT"
+47 SET STATX=$$LOW^XLFSTR($PIECE($GET(^TIU(8925.6,+$PIECE(TIUD0,U,5),0)),U))
+48 SET TIUFLDS("STATUS")="STATX"
+49 SET INSTA=""
+50 IF +$PIECE(TIUD12,U,12)>0
Begin DoDot:1
+51 SET TIUSTN=$$NS^XUAF4($PIECE(TIUD12,U,12))
+52 IF $PIECE(TIUSTN,U,2)]""
SET INSTA=$PIECE(TIUSTN,U,2)
End DoDot:1
+53 SET INSTA=$EXTRACT(INSTA,1,8)
+54 SET TIUFLDS("DIVISION")="INSTA"
+55 SET (TIUI,TIUY)=""
+56 SET TIUY=$$SETFLD^VALM1(TSTART,TIUY,"NUMBER")
+57 FOR
SET TIUI=$ORDER(TIUFLDS(TIUI))
if TIUI=""
QUIT
Begin DoDot:1
+58 if $DATA(VALMDDF(TIUI))
SET TIUY=$$SETFLD^VALM1(@TIUFLDS(TIUI),TIUY,TIUI)
End DoDot:1
RESOLVEX QUIT TIUY
+1 ;
GETPT(TIUD0,PREFIX) ; Get patient column data; put updated prefix data
+1 ;in second ^ piece
+2 ; Receives TIUDO, PREFIX.
+3 ; Returns (patient col data)^PREFIX
+4 NEW TIUY
+5 SET TIUY=$$NAME^TIULS($$PTNAME^TIULC1($PIECE(TIUD0,U,2)),"LAST,FI MI")
+6 IF $DATA(PREFIX)
SET TIUY=TIUY_U_PREFIX
+7 QUIT TIUY
+8 ;
GETTL(TIUD0,PREFIX) ; Get title column data; put updated prefix
+1 ;data in second ^ piece.
+2 ; Receives TIUDO, PREFIX.
+3 ; Returns (title col data)^PREFIX
+4 NEW TIUY
+5 SET TIUY=$$PNAME^TIULC1(+TIUD0)
+6 IF TIUY="Addendum"
SET TIUY="Addendum to "_$$PNAME^TIULC1(+$GET(^TIU(8925,+$PIECE(TIUD0,U,6),0)))
+7 IF $DATA(PREFIX)
SET TIUY=TIUY_U_PREFIX
+8 QUIT TIUY
+9 ;
SETTLPT(STRING,DA,PREFIX) ; Set field TITLE or PATIENT into string,
+1 ;with prefix as first chars of string.
+2 ; Receives STRING, DA, PREFIX:
+3 ; PREFIX = beginning chars of title/pt column, up to but not
+4 ; including title/pt itself.
+5 ; Returns STRING.
+6 NEW PT,DOC,TIUD0
+7 SET TIUD0=^TIU(8925,DA,0)
+8 IF $DATA(VALMDDF("PATIENT NAME"))
Begin DoDot:1
+9 SET PT=$$GETPT(TIUD0,PREFIX)
+10 SET PT=$PIECE(PT,U,2)_$PIECE(PT,U)
+11 SET STRING=$$SETFLD^VALM1(PT,STRING,"PATIENT NAME")
End DoDot:1
IF 1
+12 IF '$TEST
Begin DoDot:1
+13 SET DOC=$$GETTL(TIUD0,PREFIX)
+14 SET DOC=$PIECE(DOC,U,2)_$PIECE(DOC,U)
+15 SET STRING=$$SETFLD^VALM1(DOC,STRING,"TITLE")
End DoDot:1
+16 QUIT STRING
