TIUR2 ; SLC/JER - Integrated Document Review ;04-Jun-2012 16:23;DU
;;1.0;TEXT INTEGRATION UTILITIES;**100,113,1005,1009,208,1010**;Jun 20, 1997;Build 24
; 12/12/00 new rtn, from splitting TIUR1
;IHS/ITSC/LJF 02/27/2003 changed SSN to HRCN
;IHS/MSC/MGH Patch 1005 changed the HRCN call for divisions
REPLACE(TIUDA,SORTVAL,SORTFLD,DATTIM,EXPAND,FORGETAD) ; Fix ^TMP("TIUI",$J).
;Remove ID kid or addm records from ^TMP("TIUI",$J), and replace
;with parent record instead.
; Requires TIUDA, SORTVAL, SORTFLD, DATTIM.
; Passes back opt array EXPAND, where EXPAND(IFN)=""
; opt flag FORGETAD: don't expand parent for sake of addm
N IDPRNT,ADDMPRNT,ADDMGPNT,PVAL,GPVAL,PDATTIM,GPDATTIM,NODE
S IDPRNT=+$G(^TIU(8925,TIUDA,21)) ; ID parent
I '$D(^TIU(8925,IDPRNT,0)) S IDPRNT=0
I IDPRNT D
. S PVAL=$$RESOLVE^TIUR1(IDPRNT,SORTFLD)
. S PDATTIM=$S(^TMP("TIUR",$J,"RTN")="TIURM":+$G(^TIU(8925,IDPRNT,12)),1:+$G(^TIU(8925,IDPRNT,13))) ; rtn TIURM uses "F" XREF, whose date is ENTRY DT.
. S PDATTIM=9999999-PDATTIM
S ADDMPRNT=+$P($G(^TIU(8925,TIUDA,0)),U,6) ; assume TIUDA is not component
I '$D(^TIU(8925,ADDMPRNT,0)) S ADDMPRNT=0
I ADDMPRNT D
. S PVAL=$$RESOLVE^TIUR1(ADDMPRNT,SORTFLD)
. S PDATTIM=$S(^TMP("TIUR",$J,"RTN")="TIUR":+$G(^TIU(8925,ADDMPRNT,13)),1:+$G(^TIU(8925,ADDMPRNT,12)))
. S PDATTIM=9999999-PDATTIM
S EXPAND=+$G(EXPAND)
; -- If TIUDA is not an ID kid, not addm, just quit: --
I 'IDPRNT,'ADDMPRNT Q
; -- Take kid or addm out of array:
S NODE=^TMP("TIUI",$J,SORTVAL,DATTIM,TIUDA)
K ^TMP("TIUI",$J,SORTVAL,DATTIM,TIUDA)
; -- If TIUDA is an ID kid, put its parent in array:
I IDPRNT D Q
. I '$D(EXPAND(IDPRNT)) S EXPAND(IDPRNT)="",EXPAND=EXPAND+1
. Q:$$CHKPAR(IDPRNT)
. S ^TMP("TIUI",$J,PVAL,PDATTIM,IDPRNT)=NODE
; -- If TIUDA is an addendum, put its (g)parent in array:
I ADDMPRNT D Q
. I '$G(FORGETAD),'$D(EXPAND(ADDMPRNT)) S EXPAND(ADDMPRNT)="",EXPAND=EXPAND+1
. S ADDMGPNT=+$G(^TIU(8925,ADDMPRNT,21))
. I '$D(^TIU(8925,ADDMGPNT,0)) S ADDMGPNT=0
. I ADDMGPNT D I 1
. . S GPVAL=$$RESOLVE^TIUR1(ADDMGPNT,SORTFLD)
. . S GPDATTIM=$S(^TMP("TIUR",$J,"RTN")="TIUR":+$G(^TIU(8925,ADDMGPNT,13)),1:+$G(^TIU(8925,ADDMGPNT,12)))
. . S GPDATTIM=9999999-GPDATTIM
. . I '$D(EXPAND(ADDMGPNT)) S EXPAND(ADDMGPNT)="",EXPAND=EXPAND+1
. . Q:$$CHKPAR(ADDMGPNT)
. . S ^TMP("TIUI",$J,GPVAL,GPDATTIM,ADDMGPNT)=NODE
. E D
. . Q:$$CHKPAR(ADDMPRNT)
. . S ^TMP("TIUI",$J,PVAL,PDATTIM,ADDMPRNT)=NODE
Q
;
CHKPAR(CHKDA) ;
N TIU1,TIU2,TIU3,TIURES
S TIU1="",TIURES=0
F S TIU1=$O(^TMP("TIUI",$J,TIU1)) Q:TIU1=""!(TIURES) D
. S TIU2=""
. F S TIU2=$O(^TMP("TIUI",$J,TIU1,TIU2)) Q:TIU2=""!(TIURES) D
. . S TIU3=""
. . F S TIU3=$O(^TMP("TIUI",$J,TIU1,TIU2,TIU3)) Q:TIU3=""!(TIURES) D
. . . I TIU3=ADDMPRNT S TIURES=1
Q TIURES
;
SETLIST(TIUORDER,VALMCNT,SCREEN) ; Set items from ^TMP("TIUI",$J) into
;List Template list
N SORTVAL,TIUDTM,TIUDA
S SORTVAL=""
F S SORTVAL=$O(^TMP("TIUI",$J,SORTVAL),TIUORDER) Q:SORTVAL="" D
. S TIUDTM=0
. F S TIUDTM=$O(^TMP("TIUI",$J,SORTVAL,TIUDTM)) Q:'TIUDTM D
. . S TIUDA=0
. . F S TIUDA=$O(^TMP("TIUI",$J,SORTVAL,TIUDTM,TIUDA)) Q:'TIUDA D
. . . ; D ADDELMNT(TIUDA,.VALMCNT) ; P113
. . . I SCREEN=1!(SCREEN="ALL") D ADDELMNT(TIUDA,.VALMCNT)
. . . I SCREEN>1,$G(^TMP("TIUI",$J,SORTVAL,TIUDTM,TIUDA))=SCREEN D ADDELMNT(TIUDA,.VALMCNT)
Q
;
PUTLIST(TIUPREF,TIUCLASS,STATUS,SCREEN) ; Puts elements in List Template list
N TIUJ,TIUQ,TIUDA,TIUPICK,TIUORDER,TIUEXPKD,TIUSFLD
S VALMCNT=0
S TIUSFLD=$P(TIUPREF,U,3)
S TIUSFLD=$S(TIUSFLD="P":".02",TIUSFLD="D":".01",TIUSFLD="S":".05",TIUSFLD="C":"1507",TIUSFLD="A":"1202",TIUSFLD="E":"1208",1:"1301")
S TIUORDER=$S($P(TIUPREF,U,4)="A":1,1:-1) ;A for ascending
S TIUPICK=+$O(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
S TIUQ="" F S TIUQ=$O(^TMP("TIUI",$J,TIUQ)) Q:TIUQ']"" D
. S TIUJ=0 F S TIUJ=$O(^TMP("TIUI",$J,TIUQ,TIUJ)) Q:+TIUJ'>0 D
. . S TIUDA=0
. . F S TIUDA=$O(^TMP("TIUI",$J,TIUQ,TIUJ,TIUDA)) Q:+TIUDA'>0 D
. . . D REPLACE(TIUDA,TIUQ,TIUSFLD,TIUJ,.TIUEXPKD)
D SETLIST(TIUORDER,.VALMCNT,SCREEN)
S ^TMP("TIUR",$J,0)=+$G(VALMCNT)_U_STATUS("WORDS")
S TIUJ=0,SCREEN="" F S TIUJ=$O(SCREEN(TIUJ)) Q:+TIUJ'>0 D
. S SCREEN=$G(SCREEN)_$S(TIUJ>1:";",1:U)_SCREEN(TIUJ)
S ^TMP("TIUR",$J,0)=^TMP("TIUR",$J,0)_$G(SCREEN)
S ^TMP("TIUR",$J,"CLASS")=TIUCLASS
S ^TMP("TIUR",$J,"#")=TIUPICK_"^1:"_+$G(VALMCNT)
I $D(VALMHDR)>9 D HDR^TIURH
I +$G(VALMCNT)'>0 D
. S ^TMP("TIUR",$J,1,0)="",VALMCNT=2
. S ^TMP("TIUR",$J,2,0)=" No records found to satisfy search criteria."
. S ^TMP("TIUR",$J,"IDX",1,0)="" ; User can't select lines 1 or 2
. S ^TMP("TIUR",$J,"IDX",2,0)=""
I '$G(TIURBLD),$D(TIUEXPKD) D EXPANDKD(.TIUEXPKD,STATUS("WORDS"))
Q
;
EXPANDKD(TIUEXPKD,STATWORD,CONTEXT) ; Expand items to show kids that meet
;search criteria.
; Requires array TIUEXPKD, requires VALMCNT
; Requires nonnull: STATWORD (from TIUR1) or CONTEXT (from TIUROR).
N TIUEXP2,YESEXPD,LINENO,HELP,TIUTWO
; -- Expand only for status unsigned or uncosigned, & not for "ALL":
I STATWORD]"" Q:((STATWORD["ALL")!((STATWORD'["UNSIGNED")&(STATWORD'["UNCOSIGNED")))
I $G(CONTEXT) Q:((CONTEXT'=2)&(CONTEXT'=3)) ;unsigned, uncosigned
I (5*TIUEXPKD+$G(VALMCNT))>50 D Q:'YESEXPD
. W !!," There are ",TIUEXPKD," items (Interdisciplinary Notes, Addenda) to expand",!," in a list of ",VALMCNT," items."
. S HELP="NO saves time building the list, but 'hides' relevant items under their parent until you expand the parent yourself."
. S YESEXPD=$$READ^TIUU("Y"," Shall I take the extra time to expand them before I list them","NO",HELP)
D LOAD^TIUROR1(.TIUEXPKD,.TIUEXP2)
D BREATHE^TIUROR1(1)
; Try again if not in list til expanded once:
; (Can't use BREATHE^TIUROR1 again since it COLLAPSES now.)
Q:'$D(TIUEXP2)
S TIUDA=0
F S TIUDA=$O(TIUEXP2(TIUDA)) Q:'TIUDA D
. S LINENO=$O(^TMP("TIUR",$J,"IEN",TIUDA,0))
. Q:'LINENO
. S TIUTWO(LINENO)=""
S LINENO=VALMCNT+1
F S LINENO=$O(TIUTWO(LINENO),-1) Q:'LINENO D
. D BREATHE^TIURL1(LINENO,1)
Q
;
ADDELMNT(TIUDA,TIUCNT,APPEND) ; Add each element to the list
N PT,ADT,DDT,AUT,AMD,EDT,SDT,XDT,TIULST4,INSTA,TIUSTN
N TIUREC,TIUD0,TIUD12,TIUD13,TIUD15,TIULI,STATX,DOC
N PREFIX,TIUGDATA
I '$D(^TIU(8925,TIUDA,0)) Q
I $G(^TMP("TIUR",$J,2,0))=" No records found to satisfy search criteria." D
. K ^TMP("TIUR",$J,2),^TMP("TIUR",$J,"IDX",2),^TMP("TIUR",$J,"IDX",1)
. S TIUCNT=0
S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD12=$G(^TIU(8925,TIUDA,12))
S TIUD13=$G(^TIU(8925,TIUDA,13)),TIUD15=$G(^TIU(8925,TIUDA,15))
S DOC=$$PNAME^TIULC1(+TIUD0)
I DOC="Addendum" S DOC=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUD0,U,6),0)))
S PREFIX=$$PREFIX^TIULA2(TIUDA,0)
S PT=$$NAME^TIULS($$PTNAME^TIULC1($P(TIUD0,U,2)),"LAST,FI MI")
S TIULI=$E(PT)
S PT=PREFIX_PT
;S TIULST4=$E($P($G(^DPT(+$P(TIUD0,U,2),0)),U,9),6,9) ;IHS/ITSC/LJF
;S TIULST4="("_TIULI_TIULST4_")" ;IHS/ITSC/LJF
;IHS/MSC/MGH Changed to allow viewing of notes from another division
N HRCN S HRCN="" S DFN=$P(TIUD0,U,2)
S HRCN=$$HRCN^TIUR2(DFN,+$G(DUZ(2)))
I HRCN'="" S TIULST4="#"_HRCN
I HRCN="",+$D(^XUSEC("TIU VIEWALL",DUZ)) S TIULST4="Unknown"
I HRCN="",'+$D(^XUSEC("TIU VIEWALL",DUZ)) Q
;End modification
S ADT=$$DATE^TIULS($P(TIUD0,U,7),"MM/DD/YY")
S DDT=$$DATE^TIULS($P(TIUD0,U,8),"MM/DD/YY")
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 AUT=$$NAME^TIULS(AUT,"LAST, FI MI")
S EDT=$$DATE^TIULS($P(TIUD13,U),"MM/DD/YY")
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 STATX=$P($G(^TIU(8925.6,+$P(TIUD0,U,5),0)),U)
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 TIUCNT=+$G(TIUCNT)+1
S TIUREC=$$SETFLD^VALM1(TIUCNT,"","NUMBER")
S TIUREC=$$SETFLD^VALM1(PT,TIUREC,"PATIENT NAME")
S TIUREC=$$SETFLD^VALM1(TIULST4,TIUREC,"LAST I/LAST 4")
S TIUREC=$$SETFLD^VALM1(DOC,TIUREC,"DOCUMENT TYPE")
S TIUREC=$$SETFLD^VALM1(EDT,TIUREC,"REF DATE")
S TIUREC=$$SETFLD^VALM1($$LOWER^TIULS(STATX),TIUREC,"STATUS")
S TIUREC=$$SETFLD^VALM1(SDT,TIUREC,"SIG DATE")
S TIUREC=$$SETFLD^VALM1(AUT,TIUREC,"AUTHOR")
S TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"EXPECTED COSIGNER")
S TIUREC=$$SETFLD^VALM1(INSTA,TIUREC,"DIVISION")
S ^TMP("TIUR",$J,TIUCNT,0)=TIUREC
S ^TMP("TIUR",$J,"IDX",TIUCNT,TIUCNT)="" W:TIUCNT#10'>0 "."
S ^TMP("TIURIDX",$J,TIUCNT)=TIUCNT_U_TIUDA_U_PREFIX
S ^TMP("TIUR",$J,"IEN",TIUDA,TIUCNT)="" ;MARGY 11/11/00
S TIUGDATA=$$IDDATA^TIURECL1(TIUDA,TIUD0)
I TIUGDATA S ^TMP("TIUR",$J,"IDDATA",TIUDA)=TIUGDATA
I +$G(APPEND) D
. D RESTORE^VALM10(TIUCNT)
. D CNTRL^VALM10(TIUCNT,1,$G(VALM("RM")),IOINHI,IOINORM),HDR^TIURH
. S VALMSG="** Item(s) #"_$$ITMLIST(TIUCNT,$G(VALMSG))_" Added **"
. S $P(^TMP("TIUR",$J,0),U)=TIUCNT
. S $P(^TMP("TIUR",$J,"#"),":",2)=TIUCNT
. S VALMCNT=TIUCNT
. I $D(VALMHDR)>9 D HDR^TIURH
Q
ITMLIST(TIUITM,TIUMSG) ; Add Message
N TIULIST
I $E($G(TIUMSG),1,7)'="** Item" S TIULIST=TIUITM G ITMLISTX
S TIULIST=$P($P($G(TIUMSG)," Added **"),"#",2)_" & "_TIUITM
ITMLISTX Q $G(TIULIST)
Q
HRCN(DFN,SITE) ;EP; IHS/MSC/MGH return chart number
Q $P($G(^AUPNPAT(DFN,41,SITE,0)),U,2)
TIUR2 ; SLC/JER - Integrated Document Review ;04-Jun-2012 16:23;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**100,113,1005,1009,208,1010**;Jun 20, 1997;Build 24
+2 ; 12/12/00 new rtn, from splitting TIUR1
+3 ;IHS/ITSC/LJF 02/27/2003 changed SSN to HRCN
+4 ;IHS/MSC/MGH Patch 1005 changed the HRCN call for divisions
REPLACE(TIUDA,SORTVAL,SORTFLD,DATTIM,EXPAND,FORGETAD) ; Fix ^TMP("TIUI",$J).
+1 ;Remove ID kid or addm records from ^TMP("TIUI",$J), and replace
+2 ;with parent record instead.
+3 ; Requires TIUDA, SORTVAL, SORTFLD, DATTIM.
+4 ; Passes back opt array EXPAND, where EXPAND(IFN)=""
+5 ; opt flag FORGETAD: don't expand parent for sake of addm
+6 NEW IDPRNT,ADDMPRNT,ADDMGPNT,PVAL,GPVAL,PDATTIM,GPDATTIM,NODE
+7 ; ID parent
SET IDPRNT=+$GET(^TIU(8925,TIUDA,21))
+8 IF '$DATA(^TIU(8925,IDPRNT,0))
SET IDPRNT=0
+9 IF IDPRNT
Begin DoDot:1
+10 SET PVAL=$$RESOLVE^TIUR1(IDPRNT,SORTFLD)
+11 ; rtn TIURM uses "F" XREF, whose date is ENTRY DT.
SET PDATTIM=$SELECT(^TMP("TIUR",$JOB,"RTN")="TIURM":+$GET(^TIU(8925,IDPRNT,12)),1:+$GET(^TIU(8925,IDPRNT,13)))
+12 SET PDATTIM=9999999-PDATTIM
End DoDot:1
+13 ; assume TIUDA is not component
SET ADDMPRNT=+$PIECE($GET(^TIU(8925,TIUDA,0)),U,6)
+14 IF '$DATA(^TIU(8925,ADDMPRNT,0))
SET ADDMPRNT=0
+15 IF ADDMPRNT
Begin DoDot:1
+16 SET PVAL=$$RESOLVE^TIUR1(ADDMPRNT,SORTFLD)
+17 SET PDATTIM=$SELECT(^TMP("TIUR",$JOB,"RTN")="TIUR":+$GET(^TIU(8925,ADDMPRNT,13)),1:+$GET(^TIU(8925,ADDMPRNT,12)))
+18 SET PDATTIM=9999999-PDATTIM
End DoDot:1
+19 SET EXPAND=+$GET(EXPAND)
+20 ; -- If TIUDA is not an ID kid, not addm, just quit: --
+21 IF 'IDPRNT
IF 'ADDMPRNT
QUIT
+22 ; -- Take kid or addm out of array:
+23 SET NODE=^TMP("TIUI",$JOB,SORTVAL,DATTIM,TIUDA)
+24 KILL ^TMP("TIUI",$JOB,SORTVAL,DATTIM,TIUDA)
+25 ; -- If TIUDA is an ID kid, put its parent in array:
+26 IF IDPRNT
Begin DoDot:1
+27 IF '$DATA(EXPAND(IDPRNT))
SET EXPAND(IDPRNT)=""
SET EXPAND=EXPAND+1
+28 IF $$CHKPAR(IDPRNT)
QUIT
+29 SET ^TMP("TIUI",$JOB,PVAL,PDATTIM,IDPRNT)=NODE
End DoDot:1
QUIT
+30 ; -- If TIUDA is an addendum, put its (g)parent in array:
+31 IF ADDMPRNT
Begin DoDot:1
+32 IF '$GET(FORGETAD)
IF '$DATA(EXPAND(ADDMPRNT))
SET EXPAND(ADDMPRNT)=""
SET EXPAND=EXPAND+1
+33 SET ADDMGPNT=+$GET(^TIU(8925,ADDMPRNT,21))
+34 IF '$DATA(^TIU(8925,ADDMGPNT,0))
SET ADDMGPNT=0
+35 IF ADDMGPNT
Begin DoDot:2
+36 SET GPVAL=$$RESOLVE^TIUR1(ADDMGPNT,SORTFLD)
+37 SET GPDATTIM=$SELECT(^TMP("TIUR",$JOB,"RTN")="TIUR":+$GET(^TIU(8925,ADDMGPNT,13)),1:+$GET(^TIU(8925,ADDMGPNT,12)))
+38 SET GPDATTIM=9999999-GPDATTIM
+39 IF '$DATA(EXPAND(ADDMGPNT))
SET EXPAND(ADDMGPNT)=""
SET EXPAND=EXPAND+1
+40 IF $$CHKPAR(ADDMGPNT)
QUIT
+41 SET ^TMP("TIUI",$JOB,GPVAL,GPDATTIM,ADDMGPNT)=NODE
End DoDot:2
IF 1
+42 IF '$TEST
Begin DoDot:2
+43 IF $$CHKPAR(ADDMPRNT)
QUIT
+44 SET ^TMP("TIUI",$JOB,PVAL,PDATTIM,ADDMPRNT)=NODE
End DoDot:2
End DoDot:1
QUIT
+45 QUIT
+46 ;
CHKPAR(CHKDA) ;
+1 NEW TIU1,TIU2,TIU3,TIURES
+2 SET TIU1=""
SET TIURES=0
+3 FOR
SET TIU1=$ORDER(^TMP("TIUI",$JOB,TIU1))
IF TIU1=""!(TIURES)
QUIT
Begin DoDot:1
+4 SET TIU2=""
+5 FOR
SET TIU2=$ORDER(^TMP("TIUI",$JOB,TIU1,TIU2))
IF TIU2=""!(TIURES)
QUIT
Begin DoDot:2
+6 SET TIU3=""
+7 FOR
SET TIU3=$ORDER(^TMP("TIUI",$JOB,TIU1,TIU2,TIU3))
IF TIU3=""!(TIURES)
QUIT
Begin DoDot:3
+8 IF TIU3=ADDMPRNT
SET TIURES=1
End DoDot:3
End DoDot:2
End DoDot:1
+9 QUIT TIURES
+10 ;
SETLIST(TIUORDER,VALMCNT,SCREEN) ; Set items from ^TMP("TIUI",$J) into
+1 ;List Template list
+2 NEW SORTVAL,TIUDTM,TIUDA
+3 SET SORTVAL=""
+4 FOR
SET SORTVAL=$ORDER(^TMP("TIUI",$JOB,SORTVAL),TIUORDER)
IF SORTVAL=""
QUIT
Begin DoDot:1
+5 SET TIUDTM=0
+6 FOR
SET TIUDTM=$ORDER(^TMP("TIUI",$JOB,SORTVAL,TIUDTM))
IF 'TIUDTM
QUIT
Begin DoDot:2
+7 SET TIUDA=0
+8 FOR
SET TIUDA=$ORDER(^TMP("TIUI",$JOB,SORTVAL,TIUDTM,TIUDA))
IF 'TIUDA
QUIT
Begin DoDot:3
+9 ; D ADDELMNT(TIUDA,.VALMCNT) ; P113
+10 IF SCREEN=1!(SCREEN="ALL")
DO ADDELMNT(TIUDA,.VALMCNT)
+11 IF SCREEN>1
IF $GET(^TMP("TIUI",$JOB,SORTVAL,TIUDTM,TIUDA))=SCREEN
DO ADDELMNT(TIUDA,.VALMCNT)
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
PUTLIST(TIUPREF,TIUCLASS,STATUS,SCREEN) ; Puts elements in List Template list
+1 NEW TIUJ,TIUQ,TIUDA,TIUPICK,TIUORDER,TIUEXPKD,TIUSFLD
+2 SET VALMCNT=0
+3 SET TIUSFLD=$PIECE(TIUPREF,U,3)
+4 SET TIUSFLD=$SELECT(TIUSFLD="P":".02",TIUSFLD="D":".01",TIUSFLD="S":".05",TIUSFLD="C":"1507",TIUSFLD="A":"1202",TIUSFLD="E":"1208",1:"1301")
+5 ;A for ascending
SET TIUORDER=$SELECT($PIECE(TIUPREF,U,4)="A":1,1:-1)
+6 SET TIUPICK=+$ORDER(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
+7 SET TIUQ=""
FOR
SET TIUQ=$ORDER(^TMP("TIUI",$JOB,TIUQ))
IF TIUQ']""
QUIT
Begin DoDot:1
+8 SET TIUJ=0
FOR
SET TIUJ=$ORDER(^TMP("TIUI",$JOB,TIUQ,TIUJ))
IF +TIUJ'>0
QUIT
Begin DoDot:2
+9 SET TIUDA=0
+10 FOR
SET TIUDA=$ORDER(^TMP("TIUI",$JOB,TIUQ,TIUJ,TIUDA))
IF +TIUDA'>0
QUIT
Begin DoDot:3
+11 DO REPLACE(TIUDA,TIUQ,TIUSFLD,TIUJ,.TIUEXPKD)
End DoDot:3
End DoDot:2
End DoDot:1
+12 DO SETLIST(TIUORDER,.VALMCNT,SCREEN)
+13 SET ^TMP("TIUR",$JOB,0)=+$GET(VALMCNT)_U_STATUS("WORDS")
+14 SET TIUJ=0
SET SCREEN=""
FOR
SET TIUJ=$ORDER(SCREEN(TIUJ))
IF +TIUJ'>0
QUIT
Begin DoDot:1
+15 SET SCREEN=$GET(SCREEN)_$SELECT(TIUJ>1:";",1:U)_SCREEN(TIUJ)
End DoDot:1
+16 SET ^TMP("TIUR",$JOB,0)=^TMP("TIUR",$JOB,0)_$GET(SCREEN)
+17 SET ^TMP("TIUR",$JOB,"CLASS")=TIUCLASS
+18 SET ^TMP("TIUR",$JOB,"#")=TIUPICK_"^1:"_+$GET(VALMCNT)
+19 IF $DATA(VALMHDR)>9
DO HDR^TIURH
+20 IF +$GET(VALMCNT)'>0
Begin DoDot:1
+21 SET ^TMP("TIUR",$JOB,1,0)=""
SET VALMCNT=2
+22 SET ^TMP("TIUR",$JOB,2,0)=" No records found to satisfy search criteria."
+23 ; User can't select lines 1 or 2
SET ^TMP("TIUR",$JOB,"IDX",1,0)=""
+24 SET ^TMP("TIUR",$JOB,"IDX",2,0)=""
End DoDot:1
+25 IF '$GET(TIURBLD)
IF $DATA(TIUEXPKD)
DO EXPANDKD(.TIUEXPKD,STATUS("WORDS"))
+26 QUIT
+27 ;
EXPANDKD(TIUEXPKD,STATWORD,CONTEXT) ; Expand items to show kids that meet
+1 ;search criteria.
+2 ; Requires array TIUEXPKD, requires VALMCNT
+3 ; Requires nonnull: STATWORD (from TIUR1) or CONTEXT (from TIUROR).
+4 NEW TIUEXP2,YESEXPD,LINENO,HELP,TIUTWO
+5 ; -- Expand only for status unsigned or uncosigned, & not for "ALL":
+6 IF STATWORD]""
IF ((STATWORD["ALL")!((STATWORD'["UNSIGNED")&(STATWORD'["UNCOSIGNED")))
QUIT
+7 ;unsigned, uncosigned
IF $GET(CONTEXT)
IF ((CONTEXT'=2)&(CONTEXT'=3))
QUIT
+8 IF (5*TIUEXPKD+$GET(VALMCNT))>50
Begin DoDot:1
+9 WRITE !!," There are ",TIUEXPKD," items (Interdisciplinary Notes, Addenda) to expand",!," in a list of ",VALMCNT," items."
+10 SET HELP="NO saves time building the list, but 'hides' relevant items under their parent until you expand the parent yourself."
+11 SET YESEXPD=$$READ^TIUU("Y"," Shall I take the extra time to expand them before I list them","NO",HELP)
End DoDot:1
IF 'YESEXPD
QUIT
+12 DO LOAD^TIUROR1(.TIUEXPKD,.TIUEXP2)
+13 DO BREATHE^TIUROR1(1)
+14 ; Try again if not in list til expanded once:
+15 ; (Can't use BREATHE^TIUROR1 again since it COLLAPSES now.)
+16 IF '$DATA(TIUEXP2)
QUIT
+17 SET TIUDA=0
+18 FOR
SET TIUDA=$ORDER(TIUEXP2(TIUDA))
IF 'TIUDA
QUIT
Begin DoDot:1
+19 SET LINENO=$ORDER(^TMP("TIUR",$JOB,"IEN",TIUDA,0))
+20 IF 'LINENO
QUIT
+21 SET TIUTWO(LINENO)=""
End DoDot:1
+22 SET LINENO=VALMCNT+1
+23 FOR
SET LINENO=$ORDER(TIUTWO(LINENO),-1)
IF 'LINENO
QUIT
Begin DoDot:1
+24 DO BREATHE^TIURL1(LINENO,1)
End DoDot:1
+25 QUIT
+26 ;
ADDELMNT(TIUDA,TIUCNT,APPEND) ; Add each element to the list
+1 NEW PT,ADT,DDT,AUT,AMD,EDT,SDT,XDT,TIULST4,INSTA,TIUSTN
+2 NEW TIUREC,TIUD0,TIUD12,TIUD13,TIUD15,TIULI,STATX,DOC
+3 NEW PREFIX,TIUGDATA
+4 IF '$DATA(^TIU(8925,TIUDA,0))
QUIT
+5 IF $GET(^TMP("TIUR",$JOB,2,0))=" No records found to satisfy search criteria."
Begin DoDot:1
+6 KILL ^TMP("TIUR",$JOB,2),^TMP("TIUR",$JOB,"IDX",2),^TMP("TIUR",$JOB,"IDX",1)
+7 SET TIUCNT=0
End DoDot:1
+8 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
SET TIUD12=$GET(^TIU(8925,TIUDA,12))
+9 SET TIUD13=$GET(^TIU(8925,TIUDA,13))
SET TIUD15=$GET(^TIU(8925,TIUDA,15))
+10 SET DOC=$$PNAME^TIULC1(+TIUD0)
+11 IF DOC="Addendum"
SET DOC=DOC_" to "_$$PNAME^TIULC1(+$GET(^TIU(8925,+$PIECE(TIUD0,U,6),0)))
+12 SET PREFIX=$$PREFIX^TIULA2(TIUDA,0)
+13 SET PT=$$NAME^TIULS($$PTNAME^TIULC1($PIECE(TIUD0,U,2)),"LAST,FI MI")
+14 SET TIULI=$EXTRACT(PT)
+15 SET PT=PREFIX_PT
+16 ;S TIULST4=$E($P($G(^DPT(+$P(TIUD0,U,2),0)),U,9),6,9) ;IHS/ITSC/LJF
+17 ;S TIULST4="("_TIULI_TIULST4_")" ;IHS/ITSC/LJF
+18 ;IHS/MSC/MGH Changed to allow viewing of notes from another division
+19 NEW HRCN
SET HRCN=""
SET DFN=$PIECE(TIUD0,U,2)
+20 SET HRCN=$$HRCN^TIUR2(DFN,+$GET(DUZ(2)))
+21 IF HRCN'=""
SET TIULST4="#"_HRCN
+22 IF HRCN=""
IF +$DATA(^XUSEC("TIU VIEWALL",DUZ))
SET TIULST4="Unknown"
+23 IF HRCN=""
IF '+$DATA(^XUSEC("TIU VIEWALL",DUZ))
QUIT
+24 ;End modification
+25 SET ADT=$$DATE^TIULS($PIECE(TIUD0,U,7),"MM/DD/YY")
+26 SET DDT=$$DATE^TIULS($PIECE(TIUD0,U,8),"MM/DD/YY")
+27 SET AMD=$$PERSNAME^TIULC1($PIECE(TIUD12,U,8))
IF AMD="UNKNOWN"
SET AMD=""
+28 SET AUT=$$PERSNAME^TIULC1($PIECE(TIUD12,U,2))
IF AUT="UNKNOWN"
SET AUT=""
+29 SET AMD=$$NAME^TIULS(AMD,"LAST, FI MI")
+30 SET AUT=$$NAME^TIULS(AUT,"LAST, FI MI")
+31 SET EDT=$$DATE^TIULS($PIECE(TIUD13,U),"MM/DD/YY")
+32 SET SDT=$SELECT(+$PIECE(TIUD15,U,7):+$PIECE(TIUD15,U,7),+$PIECE(TIUD0,U,5)'<7:+$PIECE(TIUD15,U),1:"")
+33 SET SDT=$$DATE^TIULS(SDT,"MM/DD/YY")
+34 SET STATX=$PIECE($GET(^TIU(8925.6,+$PIECE(TIUD0,U,5),0)),U)
+35 SET INSTA=""
+36 IF +$PIECE(TIUD12,U,12)>0
Begin DoDot:1
+37 SET TIUSTN=$$NS^XUAF4($PIECE(TIUD12,U,12))
+38 IF $PIECE(TIUSTN,U,2)]""
SET INSTA=$PIECE(TIUSTN,U,2)
End DoDot:1
+39 SET INSTA=$EXTRACT(INSTA,1,8)
+40 SET TIUCNT=+$GET(TIUCNT)+1
+41 SET TIUREC=$$SETFLD^VALM1(TIUCNT,"","NUMBER")
+42 SET TIUREC=$$SETFLD^VALM1(PT,TIUREC,"PATIENT NAME")
+43 SET TIUREC=$$SETFLD^VALM1(TIULST4,TIUREC,"LAST I/LAST 4")
+44 SET TIUREC=$$SETFLD^VALM1(DOC,TIUREC,"DOCUMENT TYPE")
+45 SET TIUREC=$$SETFLD^VALM1(EDT,TIUREC,"REF DATE")
+46 SET TIUREC=$$SETFLD^VALM1($$LOWER^TIULS(STATX),TIUREC,"STATUS")
+47 SET TIUREC=$$SETFLD^VALM1(SDT,TIUREC,"SIG DATE")
+48 SET TIUREC=$$SETFLD^VALM1(AUT,TIUREC,"AUTHOR")
+49 SET TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"EXPECTED COSIGNER")
+50 SET TIUREC=$$SETFLD^VALM1(INSTA,TIUREC,"DIVISION")
+51 SET ^TMP("TIUR",$JOB,TIUCNT,0)=TIUREC
+52 SET ^TMP("TIUR",$JOB,"IDX",TIUCNT,TIUCNT)=""
IF TIUCNT#10'>0
WRITE "."
+53 SET ^TMP("TIURIDX",$JOB,TIUCNT)=TIUCNT_U_TIUDA_U_PREFIX
+54 ;MARGY 11/11/00
SET ^TMP("TIUR",$JOB,"IEN",TIUDA,TIUCNT)=""
+55 SET TIUGDATA=$$IDDATA^TIURECL1(TIUDA,TIUD0)
+56 IF TIUGDATA
SET ^TMP("TIUR",$JOB,"IDDATA",TIUDA)=TIUGDATA
+57 IF +$GET(APPEND)
Begin DoDot:1
+58 DO RESTORE^VALM10(TIUCNT)
+59 DO CNTRL^VALM10(TIUCNT,1,$GET(VALM("RM")),IOINHI,IOINORM)
DO HDR^TIURH
+60 SET VALMSG="** Item(s) #"_$$ITMLIST(TIUCNT,$GET(VALMSG))_" Added **"
+61 SET $PIECE(^TMP("TIUR",$JOB,0),U)=TIUCNT
+62 SET $PIECE(^TMP("TIUR",$JOB,"#"),":",2)=TIUCNT
+63 SET VALMCNT=TIUCNT
+64 IF $DATA(VALMHDR)>9
DO HDR^TIURH
End DoDot:1
+65 QUIT
ITMLIST(TIUITM,TIUMSG) ; Add Message
+1 NEW TIULIST
+2 IF $EXTRACT($GET(TIUMSG),1,7)'="** Item"
SET TIULIST=TIUITM
GOTO ITMLISTX
+3 SET TIULIST=$PIECE($PIECE($GET(TIUMSG)," Added **"),"#",2)_" & "_TIUITM
ITMLISTX QUIT $GET(TIULIST)
+1 QUIT
HRCN(DFN,SITE) ;EP; IHS/MSC/MGH return chart number
+1 QUIT $PIECE($GET(^AUPNPAT(DFN,41,SITE,0)),U,2)
