- TIUR2 ; SLC/JER - Integrated Document Review ;1/29/04
- ;;1.0;TEXT INTEGRATION UTILITIES;**100,113,208**;Jun 20, 1997
- ; 12/12/00 new rtn, from splitting TIUR1
- 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)
- S TIULST4="("_TIULI_TIULST4_")"
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUR2 8902 printed Feb 19, 2025@00:11:24 Page 2
- TIUR2 ; SLC/JER - Integrated Document Review ;1/29/04
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**100,113,208**;Jun 20, 1997
- +2 ; 12/12/00 new rtn, from splitting TIUR1
- 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 SET TIULST4=$EXTRACT($PIECE($GET(^DPT(+$PIECE(TIUD0,U,2),0)),U,9),6,9)
- +17 SET TIULST4="("_TIULI_TIULST4_")"
- +18 SET ADT=$$DATE^TIULS($PIECE(TIUD0,U,7),"MM/DD/YY")
- +19 SET DDT=$$DATE^TIULS($PIECE(TIUD0,U,8),"MM/DD/YY")
- +20 SET AMD=$$PERSNAME^TIULC1($PIECE(TIUD12,U,8))
- if AMD="UNKNOWN"
- SET AMD=""
- +21 SET AUT=$$PERSNAME^TIULC1($PIECE(TIUD12,U,2))
- if AUT="UNKNOWN"
- SET AUT=""
- +22 SET AMD=$$NAME^TIULS(AMD,"LAST, FI MI")
- +23 SET AUT=$$NAME^TIULS(AUT,"LAST, FI MI")
- +24 SET EDT=$$DATE^TIULS($PIECE(TIUD13,U),"MM/DD/YY")
- +25 SET SDT=$SELECT(+$PIECE(TIUD15,U,7):+$PIECE(TIUD15,U,7),+$PIECE(TIUD0,U,5)'<7:+$PIECE(TIUD15,U),1:"")
- +26 SET SDT=$$DATE^TIULS(SDT,"MM/DD/YY")
- +27 SET STATX=$PIECE($GET(^TIU(8925.6,+$PIECE(TIUD0,U,5),0)),U)
- +28 SET INSTA=""
- +29 IF +$PIECE(TIUD12,U,12)>0
- Begin DoDot:1
- +30 SET TIUSTN=$$NS^XUAF4($PIECE(TIUD12,U,12))
- +31 IF $PIECE(TIUSTN,U,2)]""
- SET INSTA=$PIECE(TIUSTN,U,2)
- End DoDot:1
- +32 SET INSTA=$EXTRACT(INSTA,1,8)
- +33 SET TIUCNT=+$GET(TIUCNT)+1
- +34 SET TIUREC=$$SETFLD^VALM1(TIUCNT,"","NUMBER")
- +35 SET TIUREC=$$SETFLD^VALM1(PT,TIUREC,"PATIENT NAME")
- +36 SET TIUREC=$$SETFLD^VALM1(TIULST4,TIUREC,"LAST I/LAST 4")
- +37 SET TIUREC=$$SETFLD^VALM1(DOC,TIUREC,"DOCUMENT TYPE")
- +38 SET TIUREC=$$SETFLD^VALM1(EDT,TIUREC,"REF DATE")
- +39 SET TIUREC=$$SETFLD^VALM1($$LOWER^TIULS(STATX),TIUREC,"STATUS")
- +40 SET TIUREC=$$SETFLD^VALM1(SDT,TIUREC,"SIG DATE")
- +41 SET TIUREC=$$SETFLD^VALM1(AUT,TIUREC,"AUTHOR")
- +42 SET TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"EXPECTED COSIGNER")
- +43 SET TIUREC=$$SETFLD^VALM1(INSTA,TIUREC,"DIVISION")
- +44 SET ^TMP("TIUR",$JOB,TIUCNT,0)=TIUREC
- +45 SET ^TMP("TIUR",$JOB,"IDX",TIUCNT,TIUCNT)=""
- if TIUCNT#10'>0
- WRITE "."
- +46 SET ^TMP("TIURIDX",$JOB,TIUCNT)=TIUCNT_U_TIUDA_U_PREFIX
- +47 ;MARGY 11/11/00
- SET ^TMP("TIUR",$JOB,"IEN",TIUDA,TIUCNT)=""
- +48 SET TIUGDATA=$$IDDATA^TIURECL1(TIUDA,TIUD0)
- +49 IF TIUGDATA
- SET ^TMP("TIUR",$JOB,"IDDATA",TIUDA)=TIUGDATA
- +50 IF +$GET(APPEND)
- Begin DoDot:1
- +51 DO RESTORE^VALM10(TIUCNT)
- +52 DO CNTRL^VALM10(TIUCNT,1,$GET(VALM("RM")),IOINHI,IOINORM)
- DO HDR^TIURH
- +53 SET VALMSG="** Item(s) #"_$$ITMLIST(TIUCNT,$GET(VALMSG))_" Added **"
- +54 SET $PIECE(^TMP("TIUR",$JOB,0),U)=TIUCNT
- +55 SET $PIECE(^TMP("TIUR",$JOB,"#"),":",2)=TIUCNT
- +56 SET VALMCNT=TIUCNT
- +57 IF $DATA(VALMHDR)>9
- DO HDR^TIURH
- End DoDot:1
- +58 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