Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUR2

TIUR2.m

Go to the documentation of this file.
  1. TIUR2 ; SLC/JER - Integrated Document Review ;1/29/04
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**100,113,208**;Jun 20, 1997
  1. ; 12/12/00 new rtn, from splitting TIUR1
  1. REPLACE(TIUDA,SORTVAL,SORTFLD,DATTIM,EXPAND,FORGETAD) ; Fix ^TMP("TIUI",$J).
  1. ;Remove ID kid or addm records from ^TMP("TIUI",$J), and replace
  1. ;with parent record instead.
  1. ; Requires TIUDA, SORTVAL, SORTFLD, DATTIM.
  1. ; Passes back opt array EXPAND, where EXPAND(IFN)=""
  1. ; opt flag FORGETAD: don't expand parent for sake of addm
  1. N IDPRNT,ADDMPRNT,ADDMGPNT,PVAL,GPVAL,PDATTIM,GPDATTIM,NODE
  1. S IDPRNT=+$G(^TIU(8925,TIUDA,21)) ; ID parent
  1. I '$D(^TIU(8925,IDPRNT,0)) S IDPRNT=0
  1. I IDPRNT D
  1. . S PVAL=$$RESOLVE^TIUR1(IDPRNT,SORTFLD)
  1. . 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.
  1. . S PDATTIM=9999999-PDATTIM
  1. S ADDMPRNT=+$P($G(^TIU(8925,TIUDA,0)),U,6) ; assume TIUDA is not component
  1. I '$D(^TIU(8925,ADDMPRNT,0)) S ADDMPRNT=0
  1. I ADDMPRNT D
  1. . S PVAL=$$RESOLVE^TIUR1(ADDMPRNT,SORTFLD)
  1. . S PDATTIM=$S(^TMP("TIUR",$J,"RTN")="TIUR":+$G(^TIU(8925,ADDMPRNT,13)),1:+$G(^TIU(8925,ADDMPRNT,12)))
  1. . S PDATTIM=9999999-PDATTIM
  1. S EXPAND=+$G(EXPAND)
  1. ; -- If TIUDA is not an ID kid, not addm, just quit: --
  1. I 'IDPRNT,'ADDMPRNT Q
  1. ; -- Take kid or addm out of array:
  1. S NODE=^TMP("TIUI",$J,SORTVAL,DATTIM,TIUDA)
  1. K ^TMP("TIUI",$J,SORTVAL,DATTIM,TIUDA)
  1. ; -- If TIUDA is an ID kid, put its parent in array:
  1. I IDPRNT D Q
  1. . I '$D(EXPAND(IDPRNT)) S EXPAND(IDPRNT)="",EXPAND=EXPAND+1
  1. . Q:$$CHKPAR(IDPRNT)
  1. . S ^TMP("TIUI",$J,PVAL,PDATTIM,IDPRNT)=NODE
  1. ; -- If TIUDA is an addendum, put its (g)parent in array:
  1. I ADDMPRNT D Q
  1. . I '$G(FORGETAD),'$D(EXPAND(ADDMPRNT)) S EXPAND(ADDMPRNT)="",EXPAND=EXPAND+1
  1. . S ADDMGPNT=+$G(^TIU(8925,ADDMPRNT,21))
  1. . I '$D(^TIU(8925,ADDMGPNT,0)) S ADDMGPNT=0
  1. . I ADDMGPNT D I 1
  1. . . S GPVAL=$$RESOLVE^TIUR1(ADDMGPNT,SORTFLD)
  1. . . S GPDATTIM=$S(^TMP("TIUR",$J,"RTN")="TIUR":+$G(^TIU(8925,ADDMGPNT,13)),1:+$G(^TIU(8925,ADDMGPNT,12)))
  1. . . S GPDATTIM=9999999-GPDATTIM
  1. . . I '$D(EXPAND(ADDMGPNT)) S EXPAND(ADDMGPNT)="",EXPAND=EXPAND+1
  1. . . Q:$$CHKPAR(ADDMGPNT)
  1. . . S ^TMP("TIUI",$J,GPVAL,GPDATTIM,ADDMGPNT)=NODE
  1. . E D
  1. . . Q:$$CHKPAR(ADDMPRNT)
  1. . . S ^TMP("TIUI",$J,PVAL,PDATTIM,ADDMPRNT)=NODE
  1. Q
  1. ;
  1. CHKPAR(CHKDA) ;
  1. N TIU1,TIU2,TIU3,TIURES
  1. S TIU1="",TIURES=0
  1. F S TIU1=$O(^TMP("TIUI",$J,TIU1)) Q:TIU1=""!(TIURES) D
  1. . S TIU2=""
  1. . F S TIU2=$O(^TMP("TIUI",$J,TIU1,TIU2)) Q:TIU2=""!(TIURES) D
  1. . . S TIU3=""
  1. . . F S TIU3=$O(^TMP("TIUI",$J,TIU1,TIU2,TIU3)) Q:TIU3=""!(TIURES) D
  1. . . . I TIU3=ADDMPRNT S TIURES=1
  1. Q TIURES
  1. ;
  1. SETLIST(TIUORDER,VALMCNT,SCREEN) ; Set items from ^TMP("TIUI",$J) into
  1. ;List Template list
  1. N SORTVAL,TIUDTM,TIUDA
  1. S SORTVAL=""
  1. F S SORTVAL=$O(^TMP("TIUI",$J,SORTVAL),TIUORDER) Q:SORTVAL="" D
  1. . S TIUDTM=0
  1. . F S TIUDTM=$O(^TMP("TIUI",$J,SORTVAL,TIUDTM)) Q:'TIUDTM D
  1. . . S TIUDA=0
  1. . . F S TIUDA=$O(^TMP("TIUI",$J,SORTVAL,TIUDTM,TIUDA)) Q:'TIUDA D
  1. . . . ; D ADDELMNT(TIUDA,.VALMCNT) ; P113
  1. . . . I SCREEN=1!(SCREEN="ALL") D ADDELMNT(TIUDA,.VALMCNT)
  1. . . . I SCREEN>1,$G(^TMP("TIUI",$J,SORTVAL,TIUDTM,TIUDA))=SCREEN D ADDELMNT(TIUDA,.VALMCNT)
  1. Q
  1. ;
  1. PUTLIST(TIUPREF,TIUCLASS,STATUS,SCREEN) ; Puts elements in List Template list
  1. N TIUJ,TIUQ,TIUDA,TIUPICK,TIUORDER,TIUEXPKD,TIUSFLD
  1. S VALMCNT=0
  1. S TIUSFLD=$P(TIUPREF,U,3)
  1. S TIUSFLD=$S(TIUSFLD="P":".02",TIUSFLD="D":".01",TIUSFLD="S":".05",TIUSFLD="C":"1507",TIUSFLD="A":"1202",TIUSFLD="E":"1208",1:"1301")
  1. S TIUORDER=$S($P(TIUPREF,U,4)="A":1,1:-1) ;A for ascending
  1. S TIUPICK=+$O(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
  1. S TIUQ="" F S TIUQ=$O(^TMP("TIUI",$J,TIUQ)) Q:TIUQ']"" D
  1. . S TIUJ=0 F S TIUJ=$O(^TMP("TIUI",$J,TIUQ,TIUJ)) Q:+TIUJ'>0 D
  1. . . S TIUDA=0
  1. . . F S TIUDA=$O(^TMP("TIUI",$J,TIUQ,TIUJ,TIUDA)) Q:+TIUDA'>0 D
  1. . . . D REPLACE(TIUDA,TIUQ,TIUSFLD,TIUJ,.TIUEXPKD)
  1. D SETLIST(TIUORDER,.VALMCNT,SCREEN)
  1. S ^TMP("TIUR",$J,0)=+$G(VALMCNT)_U_STATUS("WORDS")
  1. S TIUJ=0,SCREEN="" F S TIUJ=$O(SCREEN(TIUJ)) Q:+TIUJ'>0 D
  1. . S SCREEN=$G(SCREEN)_$S(TIUJ>1:";",1:U)_SCREEN(TIUJ)
  1. S ^TMP("TIUR",$J,0)=^TMP("TIUR",$J,0)_$G(SCREEN)
  1. S ^TMP("TIUR",$J,"CLASS")=TIUCLASS
  1. S ^TMP("TIUR",$J,"#")=TIUPICK_"^1:"_+$G(VALMCNT)
  1. I $D(VALMHDR)>9 D HDR^TIURH
  1. I +$G(VALMCNT)'>0 D
  1. . S ^TMP("TIUR",$J,1,0)="",VALMCNT=2
  1. . S ^TMP("TIUR",$J,2,0)=" No records found to satisfy search criteria."
  1. . S ^TMP("TIUR",$J,"IDX",1,0)="" ; User can't select lines 1 or 2
  1. . S ^TMP("TIUR",$J,"IDX",2,0)=""
  1. I '$G(TIURBLD),$D(TIUEXPKD) D EXPANDKD(.TIUEXPKD,STATUS("WORDS"))
  1. Q
  1. ;
  1. EXPANDKD(TIUEXPKD,STATWORD,CONTEXT) ; Expand items to show kids that meet
  1. ;search criteria.
  1. ; Requires array TIUEXPKD, requires VALMCNT
  1. ; Requires nonnull: STATWORD (from TIUR1) or CONTEXT (from TIUROR).
  1. N TIUEXP2,YESEXPD,LINENO,HELP,TIUTWO
  1. ; -- Expand only for status unsigned or uncosigned, & not for "ALL":
  1. I STATWORD]"" Q:((STATWORD["ALL")!((STATWORD'["UNSIGNED")&(STATWORD'["UNCOSIGNED")))
  1. I $G(CONTEXT) Q:((CONTEXT'=2)&(CONTEXT'=3)) ;unsigned, uncosigned
  1. I (5*TIUEXPKD+$G(VALMCNT))>50 D Q:'YESEXPD
  1. . W !!," There are ",TIUEXPKD," items (Interdisciplinary Notes, Addenda) to expand",!," in a list of ",VALMCNT," items."
  1. . S HELP="NO saves time building the list, but 'hides' relevant items under their parent until you expand the parent yourself."
  1. . S YESEXPD=$$READ^TIUU("Y"," Shall I take the extra time to expand them before I list them","NO",HELP)
  1. D LOAD^TIUROR1(.TIUEXPKD,.TIUEXP2)
  1. D BREATHE^TIUROR1(1)
  1. ; Try again if not in list til expanded once:
  1. ; (Can't use BREATHE^TIUROR1 again since it COLLAPSES now.)
  1. Q:'$D(TIUEXP2)
  1. S TIUDA=0
  1. F S TIUDA=$O(TIUEXP2(TIUDA)) Q:'TIUDA D
  1. . S LINENO=$O(^TMP("TIUR",$J,"IEN",TIUDA,0))
  1. . Q:'LINENO
  1. . S TIUTWO(LINENO)=""
  1. S LINENO=VALMCNT+1
  1. F S LINENO=$O(TIUTWO(LINENO),-1) Q:'LINENO D
  1. . D BREATHE^TIURL1(LINENO,1)
  1. Q
  1. ;
  1. ADDELMNT(TIUDA,TIUCNT,APPEND) ; Add each element to the list
  1. N PT,ADT,DDT,AUT,AMD,EDT,SDT,XDT,TIULST4,INSTA,TIUSTN
  1. N TIUREC,TIUD0,TIUD12,TIUD13,TIUD15,TIULI,STATX,DOC
  1. N PREFIX,TIUGDATA
  1. I '$D(^TIU(8925,TIUDA,0)) Q
  1. I $G(^TMP("TIUR",$J,2,0))=" No records found to satisfy search criteria." D
  1. . K ^TMP("TIUR",$J,2),^TMP("TIUR",$J,"IDX",2),^TMP("TIUR",$J,"IDX",1)
  1. . S TIUCNT=0
  1. S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD12=$G(^TIU(8925,TIUDA,12))
  1. S TIUD13=$G(^TIU(8925,TIUDA,13)),TIUD15=$G(^TIU(8925,TIUDA,15))
  1. S DOC=$$PNAME^TIULC1(+TIUD0)
  1. I DOC="Addendum" S DOC=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUD0,U,6),0)))
  1. S PREFIX=$$PREFIX^TIULA2(TIUDA,0)
  1. S PT=$$NAME^TIULS($$PTNAME^TIULC1($P(TIUD0,U,2)),"LAST,FI MI")
  1. S TIULI=$E(PT)
  1. S PT=PREFIX_PT
  1. S TIULST4=$E($P($G(^DPT(+$P(TIUD0,U,2),0)),U,9),6,9)
  1. S TIULST4="("_TIULI_TIULST4_")"
  1. S ADT=$$DATE^TIULS($P(TIUD0,U,7),"MM/DD/YY")
  1. S DDT=$$DATE^TIULS($P(TIUD0,U,8),"MM/DD/YY")
  1. S AMD=$$PERSNAME^TIULC1($P(TIUD12,U,8)) S:AMD="UNKNOWN" AMD=""
  1. S AUT=$$PERSNAME^TIULC1($P(TIUD12,U,2)) S:AUT="UNKNOWN" AUT=""
  1. S AMD=$$NAME^TIULS(AMD,"LAST, FI MI")
  1. S AUT=$$NAME^TIULS(AUT,"LAST, FI MI")
  1. S EDT=$$DATE^TIULS($P(TIUD13,U),"MM/DD/YY")
  1. S SDT=$S(+$P(TIUD15,U,7):+$P(TIUD15,U,7),+$P(TIUD0,U,5)'<7:+$P(TIUD15,U),1:"")
  1. S SDT=$$DATE^TIULS(SDT,"MM/DD/YY")
  1. S STATX=$P($G(^TIU(8925.6,+$P(TIUD0,U,5),0)),U)
  1. S INSTA=""
  1. I +$P(TIUD12,U,12)>0 D
  1. . S TIUSTN=$$NS^XUAF4($P(TIUD12,U,12))
  1. . I $P(TIUSTN,U,2)]"" S INSTA=$P(TIUSTN,U,2)
  1. S INSTA=$E(INSTA,1,8)
  1. S TIUCNT=+$G(TIUCNT)+1
  1. S TIUREC=$$SETFLD^VALM1(TIUCNT,"","NUMBER")
  1. S TIUREC=$$SETFLD^VALM1(PT,TIUREC,"PATIENT NAME")
  1. S TIUREC=$$SETFLD^VALM1(TIULST4,TIUREC,"LAST I/LAST 4")
  1. S TIUREC=$$SETFLD^VALM1(DOC,TIUREC,"DOCUMENT TYPE")
  1. S TIUREC=$$SETFLD^VALM1(EDT,TIUREC,"REF DATE")
  1. S TIUREC=$$SETFLD^VALM1($$LOWER^TIULS(STATX),TIUREC,"STATUS")
  1. S TIUREC=$$SETFLD^VALM1(SDT,TIUREC,"SIG DATE")
  1. S TIUREC=$$SETFLD^VALM1(AUT,TIUREC,"AUTHOR")
  1. S TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"EXPECTED COSIGNER")
  1. S TIUREC=$$SETFLD^VALM1(INSTA,TIUREC,"DIVISION")
  1. S ^TMP("TIUR",$J,TIUCNT,0)=TIUREC
  1. S ^TMP("TIUR",$J,"IDX",TIUCNT,TIUCNT)="" W:TIUCNT#10'>0 "."
  1. S ^TMP("TIURIDX",$J,TIUCNT)=TIUCNT_U_TIUDA_U_PREFIX
  1. S ^TMP("TIUR",$J,"IEN",TIUDA,TIUCNT)="" ;MARGY 11/11/00
  1. S TIUGDATA=$$IDDATA^TIURECL1(TIUDA,TIUD0)
  1. I TIUGDATA S ^TMP("TIUR",$J,"IDDATA",TIUDA)=TIUGDATA
  1. I +$G(APPEND) D
  1. . D RESTORE^VALM10(TIUCNT)
  1. . D CNTRL^VALM10(TIUCNT,1,$G(VALM("RM")),IOINHI,IOINORM),HDR^TIURH
  1. . S VALMSG="** Item(s) #"_$$ITMLIST(TIUCNT,$G(VALMSG))_" Added **"
  1. . S $P(^TMP("TIUR",$J,0),U)=TIUCNT
  1. . S $P(^TMP("TIUR",$J,"#"),":",2)=TIUCNT
  1. . S VALMCNT=TIUCNT
  1. . I $D(VALMHDR)>9 D HDR^TIURH
  1. Q
  1. ITMLIST(TIUITM,TIUMSG) ; Add Message
  1. N TIULIST
  1. I $E($G(TIUMSG),1,7)'="** Item" S TIULIST=TIUITM G ITMLISTX
  1. S TIULIST=$P($P($G(TIUMSG)," Added **"),"#",2)_" & "_TIUITM
  1. ITMLISTX Q $G(TIULIST)
  1. Q