- 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 Jan 18, 2025@03:46:23 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