TIUSRVLO ; SLC/JER - Server fns - lists for CPRS ;31-Dec-2012 15:27;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1,15,19,63,108,122,181,1007,194,1010,211,1011**;Jun 20, 1997;Build 13
;IHS/MSC/MGH call to AWCMCPR1 commented out
NOTES(TIUY,DFN,EARLY,LATE,PERSON,SEQUENCE) ; Get notes
N TIUPREF,TIUOCC S TIUPREF=$$PERSPRF^TIULE(DUZ)
S TIUOCC=$P(TIUPREF,U,10),PERSON=$S(+$G(PERSON):+$G(PERSON),1:+$G(DUZ))
S SEQUENCE=$S($G(SEQUENCE)]"":$G(SEQUENCE),1:"D")
D CONTEXT(.TIUY,3,1,DFN,$G(EARLY),$G(LATE),PERSON,TIUOCC,SEQUENCE)
Q
SUMMARY(TIUY,DFN,EARLY,LATE) ; Get Summaries
N TIUPREF,TIUOCC S TIUPREF=$$PERSPRF^TIULE(DUZ)
S TIUOCC=$P(TIUPREF,U,10),PERSON=$S(+$G(PERSON):+$G(PERSON),1:+$G(DUZ))
S SEQUENCE=$S($G(SEQUENCE)]"":$G(SEQUENCE),1:"D")
D CONTEXT(.TIUY,244,1,DFN,$G(EARLY),$G(LATE),PERSON,TIUOCC,SEQUENCE)
Q
CONTEXT(TIUY,CLASS,CONTEXT,DFN,EARLY,LATE,PERSON,OCCLIM,SEQUENCE,SHOWADD,INCUND) ; main
; --- Call with: TIUY - RETURN ARRAY pass by reference
; CLASS - Pointer to TIU DOCUMENT DEFINITION #8925.1
; CONTEXT - 1=All Signed (by PT),
; - 2="Unsigned (by PT&(AUTHOR!TANSCRIBER))
; - 3="Uncosigned (by PT&EXPECTED COSIGNER
; - 4="Signed notes (by PT&selected author)
; - 5="Signed notes (by PT&date range)
; DFN - Pointer to Patient (#2)
; [EARLY] - FM date/time to begin search
; [LATE] - FM date/time to end search
; [PERSON] - Pointer to file 200 (DUZ if not passed)
; [OCCLIM] - Occurrence Limit (optional)
; [SEQUENCE]- "A"=ascending (Regular date/time)
; - "D"=descending (Reverse date/time) (dflt)
; [INCUND] - Boolean: include undictated & untranscribed
S TIUY=$NA(^TMP("TIUR",$J))
K @TIUY
I $G(CONTEXT)'>0 Q
I $G(CLASS)'>0 Q
;IHS/MSC/MGH Patch 1007 Commented out since IHS does not use this package
;I $G(CONTEXT)=1 D STRT1^AWCMCPR1 ; TIU*1.0*181
S:+$G(EARLY)'>0!(+$G(CONTEXT)=1) EARLY=0
S:+$G(LATE)'>0!(+$G(CONTEXT)=1) LATE=5000000
I EARLY>LATE D SWAP(.EARLY,.LATE)
I $L(LATE,".")=1 D EXPRANGE(.EARLY,.LATE)
S:+$G(PERSON)'>0 PERSON=DUZ
S:$G(SEQUENCE)']"" SEQUENCE="D"
S:+$G(OCCLIM)'>0 OCCLIM=9999999
S DFN=+$G(DFN)
S EARLY=9999999-EARLY,LATE=9999999-LATE ; CHANGE TO REVERSE DATES
;
I CONTEXT=1!(CONTEXT=5) D G CTXQ
. D ACLPT(.TIUY,CLASS,DFN,LATE,EARLY,OCCLIM,SEQUENCE)
;
I CONTEXT=2 D G CTXQ
. I DFN>0 D Q
. . D ACLAU(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE,$G(INCUND))
. F S DFN=$O(^TIU(8925,"ACLAU",CLASS,PERSON,DFN)) Q:DFN'>0 D ACLAU(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE,$G(INCUND))
;
I CONTEXT=3 D G CTXQ
. I DFN>0 D Q
. . D ACLEC(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
. F S DFN=$O(^TIU(8925,"ACLEC",CLASS,PERSON,DFN)) Q:DFN'>0 D ACLEC(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
;
I CONTEXT=4 D G CTXQ
. I DFN>0 D Q
. . ;VMP OIFO BAY PINES;ELR;TIU*1.0*194 REMOVED EXECUTION OF ACLSB & ADDED APTCL
. . ;D ACLSB(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
. . D APTCL^TIUSRVLP(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
. F S DFN=$O(^TIU(8925,"APTCL",DFN)) Q:DFN'>0 D APTCL^TIUSRVLP(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
;
CTXQ K @TIUY@("INDX")
I $D(AWCSTRT) D END^AWCMCPR1 ; TIU*1.0*181
Q
;
SWAP(TIUX,TIUY) ; Swap variables
N TIUTMP S TIUTMP=TIUX,TIUX=TIUY,TIUY=TIUTMP
Q
;
EXPRANGE(TIUX,TIUY) ; Expand range when same for early & late
I TIUX=DT S TIUY=$$NOW^XLFDT I 1
E S TIUY=TIUY_"."_2359
Q
;
ACLPT(TIUY,CLASS,DFN,TIME1,TIME2,OCCLIM,SEQUENCE) ; Signed, by patient
N DATTIM,DA,ROOT,TIUI,TIUJ
S ROOT=$NA(^TIU(8925,"ACLPT",CLASS,DFN)),TIUJ=0
S DATTIM=TIME1-.0000001
F S DATTIM=$O(@ROOT@(DATTIM)) Q:$S(+DATTIM'>0:1,+DATTIM>TIME2:1,+$G(TIUJ)'<OCCLIM:1,1:0) D
. S DA=0 F S DA=$O(@ROOT@(DATTIM,DA)) Q:DA'>0 D
. . ;Added first condition to following line for interdisciplinary notes - need addenda
. . I +$G(SHOWADD)=0,(+$G(^TIU(8925,+DA,0))=81) Q
. . I +$G(^TIU(8925,+DA,0))'>0 K @ROOT@(DATTIM,DA) Q
. . Q:+$D(@TIUY@("INDX",DA))
. . ; Selectively filter DELETED or RETRACTED records
. . I +$P($G(^TIU(8925,DA,0)),U,5)>13,'+$$CANDO^TIULP(DA,"VIEW",DUZ) Q
. . S TIUI=$S(SEQUENCE="D":+$G(TIUI)+1,1:+$G(TIUI)-1)
. . S @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
. . S TIUJ=+$G(TIUJ)+1
. . S @TIUY@("INDX",DA,TIUI)=""
. . Q:+$G(SHOWADD)=0
. . I +$$HASDAD^TIUSRVLI(DA) D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
. . I +$$HASKIDS^TIUSRVLI(DA) D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
Q
;
ACLAU(TIUY,CLASS,AUTHOR,DFN,TIME1,TIME2,SEQUENCE,INCUND) ; Unsigned
N DATTIM,DA,ROOT,TIUI
S ROOT=$NA(^TIU(8925,"ACLAU",CLASS,AUTHOR,DFN))
S DATTIM=TIME1-.0000001
F S DATTIM=$O(@ROOT@(DATTIM)) Q:DATTIM'>0!(DATTIM>TIME2) D
. S DA=0 F S DA=$O(@ROOT@(DATTIM,DA)) Q:DA'>0 D
. . I +$G(^TIU(8925,+DA,0))'>0 K @ROOT@(DATTIM,DA) Q
. . I +$P($G(^TIU(8925,DA,0)),U,5)>6 K @ROOT@(DATTIM,DA) Q
. . S TIUI=$S(SEQUENCE="D":+$G(TIUI)+1,1:+$G(TIUI)-1)
. . Q:+$D(@TIUY@("INDX",DA))
. . ; Selectively filter DELETED or RETRACTED records
. . I +$P($G(^TIU(8925,DA,0)),U,5)>13,'+$$CANDO^TIULP(DA,"VIEW",DUZ) Q
. . S @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
. . S @TIUY@("INDX",DA,TIUI)=""
. . Q:+$G(SHOWADD)=0
. . I +$$HASDAD^TIUSRVLI(DA) D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
. . I +$$HASKIDS^TIUSRVLI(DA) D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
I +$G(INCUND) D GETUND^TIUSRVLI(.TIUY,CLASS,DFN,TIME1,TIME2,.TIUI,SEQUENCE)
Q
;
ACLEC(TIUY,CLASS,EXCOSIGN,DFN,TIME1,TIME2,SEQUENCE) ; Uncosigned
N DATTIM,DA,ROOT,TIUI
S ROOT=$NA(^TIU(8925,"ACLEC",CLASS,EXCOSIGN,DFN))
S DATTIM=TIME1-.0000001
F S DATTIM=$O(@ROOT@(DATTIM)) Q:DATTIM'>0!(DATTIM>TIME2) D
. S DA=0 F S DA=$O(@ROOT@(DATTIM,DA)) Q:DA'>0 D
. . I +$G(^TIU(8925,+DA,0))'>0 K @ROOT@(DATTIM,DA) Q
. . S TIUI=$S(SEQUENCE="D":+$G(TIUI)+1,1:+$G(TIUI)-1)
. . Q:+$D(@TIUY@("INDX",DA))
. . ; Selectively filter DELETED or RETRACTED records
. . I +$P($G(^TIU(8925,DA,0)),U,5)>13,'+$$CANDO^TIULP(DA,"VIEW",DUZ) Q
. . S @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
. . S @TIUY@("INDX",DA,TIUI)=""
. . Q:+$G(SHOWADD)=0
. . I +$$HASDAD^TIUSRVLI(DA) D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
. . I +$$HASKIDS^TIUSRVLI(DA) D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
Q
;
ACLSB(TIUY,CLASS,SIGNEDBY,DFN,TIME1,TIME2,SEQUENCE) ; Signed, by author
N DATTIM,DA,ROOT,TIUI
S ROOT=$NA(^TIU(8925,"ACLSB",CLASS,SIGNEDBY,DFN))
S DATTIM=TIME1-.0000001
F S DATTIM=$O(@ROOT@(DATTIM)) Q:DATTIM'>0!(DATTIM>TIME2) D
. S DA=0 F S DA=$O(@ROOT@(DATTIM,DA)) Q:DA'>0 D
. . I +$G(^TIU(8925,+DA,0))'>0 K @ROOT@(DATTIM,DA) Q
. . S TIUI=$S(SEQUENCE="D":+$G(TIUI)+1,1:+$G(TIUI)-1)
. . Q:+$D(@TIUY@("INDX",DA))
. . ; Selectively filter DELETED or RETRACTED records
. . I +$P($G(^TIU(8925,DA,0)),U,5)>13,'+$$CANDO^TIULP(DA,"VIEW",DUZ) Q
. . S @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
. . S @TIUY@("INDX",DA,TIUI)=""
. . Q:+$G(SHOWADD)=0
. . I +$$HASDAD^TIUSRVLI(DA) D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
. . I +$$HASKIDS^TIUSRVLI(DA) D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
Q
;
RESOLVE(DA) ; Resolve to external data
N DOC,LOC,PT,AUT,EDT,TIUPT,TIULST4,TIUREC,TIUR0,TIUR12,TIUR13,TIUR14
N TIUR17,STATUS,EDTCNT,LOCTYP,TIUADT,TIUDDT,PREFIX,IDPARENT,IDSORT
S PREFIX=""
S TIUR0=$G(^TIU(8925,+DA,0)),TIUR12=$G(^TIU(8925,+DA,12))
S TIUR13=$G(^TIU(8925,+DA,13)),TIUR14=$G(^(14)),TIUR17=$G(^(17))
S IDPARENT=+$G(^TIU(8925,+DA,21))
S TIUPT=$G(^DPT(+$P(TIUR0,U,2),0))
S DOC=$$PNAME^TIULC1(+TIUR0)
I +$G(^TIU(8925.1,+DA,15)) D
. N TIUD15 S TIUD15=$G(^TIU(8925.1,+DA,15))
. S DOC=DOC_";"_$P($G(^TIU(8926.1,+TIUD15,0)),U)
I DOC="Addendum" S DOC=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUR0,U,6),0)))
; If IDNotes (TIU*1.0*100) installed, use $$PREFIX^TIULA2 to evaluate
; which prefix to use:
; - keep prefix display in earlier CPRS versions and LM
; - omit in newer TreeView versions
I $L($T(PREFIX^TIULA2)) D I 1
. S PREFIX=$$PREFIX^TIULA2(DA,1) ; 1=include ID Child indicator
. I PREFIX["<" S IDSORT=$$IDSORT(DA)
. I +$G(SHOWADD)=0 S DOC=PREFIX_DOC
; otherwise, only show addendum indicator (+)
; - keep prefix display in earlier CPRS versions and LM
; - omit in newer TreeView versions
E D
. I +$$HASADDEN^TIULC1(DA) S PREFIX="+ "
. I +$G(SHOWADD)=0,(+$$HASADDEN^TIULC1(DA)) S DOC=PREFIX_DOC
I +$$URGENCY^TIURM(+DA)=1 S DOC=$S(DOC["+":"*",1:"* ")_DOC
S STATUS=$$LOWER^TIULS($P($G(^TIU(8925.6,+$P(TIUR0,U,5),0)),U))
S LOC=$G(^SC(+$P(TIUR12,U,5),0)),LOCTYP=$P(LOC,U,3),LOC=$P(LOC,U)
S TIUADT=$S(LOCTYP="W":"Adm: ",1:"Visit: ")_$$DATE^TIULS($P(TIUR0,U,7),"MM/DD/YY")
S TIUDDT=$S(+$P(TIUR0,U,8):"Dis: ",1:"")_$$DATE^TIULS($P(TIUR0,U,8),"MM/DD/YY")
I +$G(SHOWADD)>0 S TIUADT=TIUADT_";"_$P(TIUR0,U,7),TIUDDT=TIUDDT_";"_$P(TIUR0,U,8)
S PT=$$NAME^TIULS($P(TIUPT,U),"LAST, FIRST MI")
S TIULST4=$E($P(TIUPT,U,9),6,9)
S TIULST4="("_$E(PT)_TIULST4_")"
S AUT=+$P(TIUR12,U,2)
S AUT=AUT_";"_$$SIGNAME^TIULS(+$P(TIUR12,U,2))_";"_$$GET1^DIQ(200,AUT,.01)
S EDT=+TIUR13,EDTCNT=+$G(EDTCNT)+1
S TIUREC=DOC_U_EDT_U_PT_" "_TIULST4_U_AUT_U_LOC_U_STATUS_U_TIUADT_U_TIUDDT_U_$P(TIUR14,U,5)_U_$$IMGCNT(DA)_U
S TIUREC=TIUREC_$S($L(TIUR17):$E(TIUR17,1,(255-$L(TIUREC)))_U,1:U)
S TIUREC=TIUREC_$P(PREFIX," ")_U
S TIUREC=TIUREC_$S(+TIUR0=81:+$P(TIUR0,U,6),+IDPARENT:IDPARENT,+$G(CONTEXT):CONTEXT,1:1)_U_$G(IDSORT)
Q $G(TIUREC)
IMGCNT(TIUDA) ; Get the number of images associated with a document
N IMGDA,TIUI S (IMGDA,TIUI)=0
F S IMGDA=$O(^TIU(8925.91,"ADI",TIUDA,IMGDA)) Q:+IMGDA'>0 D
. S TIUI=TIUI+1
Q TIUI
IDSORT(TIUDA) ; Get ID Sort indicator when appropriate
N TIUDPRM
D DOCPRM^TIULC1(+$G(^TIU(8925,+TIUDA,0)),.TIUDPRM)
Q +$P(TIUDPRM(0),U,18)
TIUSRVLO ; SLC/JER - Server fns - lists for CPRS ;31-Dec-2012 15:27;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1,15,19,63,108,122,181,1007,194,1010,211,1011**;Jun 20, 1997;Build 13
+2 ;IHS/MSC/MGH call to AWCMCPR1 commented out
NOTES(TIUY,DFN,EARLY,LATE,PERSON,SEQUENCE) ; Get notes
+1 NEW TIUPREF,TIUOCC
SET TIUPREF=$$PERSPRF^TIULE(DUZ)
+2 SET TIUOCC=$PIECE(TIUPREF,U,10)
SET PERSON=$SELECT(+$GET(PERSON):+$GET(PERSON),1:+$GET(DUZ))
+3 SET SEQUENCE=$SELECT($GET(SEQUENCE)]"":$GET(SEQUENCE),1:"D")
+4 DO CONTEXT(.TIUY,3,1,DFN,$GET(EARLY),$GET(LATE),PERSON,TIUOCC,SEQUENCE)
+5 QUIT
SUMMARY(TIUY,DFN,EARLY,LATE) ; Get Summaries
+1 NEW TIUPREF,TIUOCC
SET TIUPREF=$$PERSPRF^TIULE(DUZ)
+2 SET TIUOCC=$PIECE(TIUPREF,U,10)
SET PERSON=$SELECT(+$GET(PERSON):+$GET(PERSON),1:+$GET(DUZ))
+3 SET SEQUENCE=$SELECT($GET(SEQUENCE)]"":$GET(SEQUENCE),1:"D")
+4 DO CONTEXT(.TIUY,244,1,DFN,$GET(EARLY),$GET(LATE),PERSON,TIUOCC,SEQUENCE)
+5 QUIT
CONTEXT(TIUY,CLASS,CONTEXT,DFN,EARLY,LATE,PERSON,OCCLIM,SEQUENCE,SHOWADD,INCUND) ; main
+1 ; --- Call with: TIUY - RETURN ARRAY pass by reference
+2 ; CLASS - Pointer to TIU DOCUMENT DEFINITION #8925.1
+3 ; CONTEXT - 1=All Signed (by PT),
+4 ; - 2="Unsigned (by PT&(AUTHOR!TANSCRIBER))
+5 ; - 3="Uncosigned (by PT&EXPECTED COSIGNER
+6 ; - 4="Signed notes (by PT&selected author)
+7 ; - 5="Signed notes (by PT&date range)
+8 ; DFN - Pointer to Patient (#2)
+9 ; [EARLY] - FM date/time to begin search
+10 ; [LATE] - FM date/time to end search
+11 ; [PERSON] - Pointer to file 200 (DUZ if not passed)
+12 ; [OCCLIM] - Occurrence Limit (optional)
+13 ; [SEQUENCE]- "A"=ascending (Regular date/time)
+14 ; - "D"=descending (Reverse date/time) (dflt)
+15 ; [INCUND] - Boolean: include undictated & untranscribed
+16 SET TIUY=$NAME(^TMP("TIUR",$JOB))
+17 KILL @TIUY
+18 IF $GET(CONTEXT)'>0
QUIT
+19 IF $GET(CLASS)'>0
QUIT
+20 ;IHS/MSC/MGH Patch 1007 Commented out since IHS does not use this package
+21 ;I $G(CONTEXT)=1 D STRT1^AWCMCPR1 ; TIU*1.0*181
+22 IF +$GET(EARLY)'>0!(+$GET(CONTEXT)=1)
SET EARLY=0
+23 IF +$GET(LATE)'>0!(+$GET(CONTEXT)=1)
SET LATE=5000000
+24 IF EARLY>LATE
DO SWAP(.EARLY,.LATE)
+25 IF $LENGTH(LATE,".")=1
DO EXPRANGE(.EARLY,.LATE)
+26 IF +$GET(PERSON)'>0
SET PERSON=DUZ
+27 IF $GET(SEQUENCE)']""
SET SEQUENCE="D"
+28 IF +$GET(OCCLIM)'>0
SET OCCLIM=9999999
+29 SET DFN=+$GET(DFN)
+30 ; CHANGE TO REVERSE DATES
SET EARLY=9999999-EARLY
SET LATE=9999999-LATE
+31 ;
+32 IF CONTEXT=1!(CONTEXT=5)
Begin DoDot:1
+33 DO ACLPT(.TIUY,CLASS,DFN,LATE,EARLY,OCCLIM,SEQUENCE)
End DoDot:1
GOTO CTXQ
+34 ;
+35 IF CONTEXT=2
Begin DoDot:1
+36 IF DFN>0
Begin DoDot:2
+37 DO ACLAU(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE,$GET(INCUND))
End DoDot:2
QUIT
+38 FOR
SET DFN=$ORDER(^TIU(8925,"ACLAU",CLASS,PERSON,DFN))
IF DFN'>0
QUIT
DO ACLAU(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE,$GET(INCUND))
End DoDot:1
GOTO CTXQ
+39 ;
+40 IF CONTEXT=3
Begin DoDot:1
+41 IF DFN>0
Begin DoDot:2
+42 DO ACLEC(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
End DoDot:2
QUIT
+43 FOR
SET DFN=$ORDER(^TIU(8925,"ACLEC",CLASS,PERSON,DFN))
IF DFN'>0
QUIT
DO ACLEC(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
End DoDot:1
GOTO CTXQ
+44 ;
+45 IF CONTEXT=4
Begin DoDot:1
+46 IF DFN>0
Begin DoDot:2
+47 ;VMP OIFO BAY PINES;ELR;TIU*1.0*194 REMOVED EXECUTION OF ACLSB & ADDED APTCL
+48 ;D ACLSB(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
+49 DO APTCL^TIUSRVLP(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
End DoDot:2
QUIT
+50 FOR
SET DFN=$ORDER(^TIU(8925,"APTCL",DFN))
IF DFN'>0
QUIT
DO APTCL^TIUSRVLP(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
End DoDot:1
GOTO CTXQ
+51 ;
CTXQ KILL @TIUY@("INDX")
+1 ; TIU*1.0*181
IF $DATA(AWCSTRT)
DO END^AWCMCPR1
+2 QUIT
+3 ;
SWAP(TIUX,TIUY) ; Swap variables
+1 NEW TIUTMP
SET TIUTMP=TIUX
SET TIUX=TIUY
SET TIUY=TIUTMP
+2 QUIT
+3 ;
EXPRANGE(TIUX,TIUY) ; Expand range when same for early & late
+1 IF TIUX=DT
SET TIUY=$$NOW^XLFDT
IF 1
+2 IF '$TEST
SET TIUY=TIUY_"."_2359
+3 QUIT
+4 ;
ACLPT(TIUY,CLASS,DFN,TIME1,TIME2,OCCLIM,SEQUENCE) ; Signed, by patient
+1 NEW DATTIM,DA,ROOT,TIUI,TIUJ
+2 SET ROOT=$NAME(^TIU(8925,"ACLPT",CLASS,DFN))
SET TIUJ=0
+3 SET DATTIM=TIME1-.0000001
+4 FOR
SET DATTIM=$ORDER(@ROOT@(DATTIM))
IF $SELECT(+DATTIM'>0
QUIT
Begin DoDot:1
+5 SET DA=0
FOR
SET DA=$ORDER(@ROOT@(DATTIM,DA))
IF DA'>0
QUIT
Begin DoDot:2
+6 ;Added first condition to following line for interdisciplinary notes - need addenda
+7 IF +$GET(SHOWADD)=0
IF (+$GET(^TIU(8925,+DA,0))=81)
QUIT
+8 IF +$GET(^TIU(8925,+DA,0))'>0
KILL @ROOT@(DATTIM,DA)
QUIT
+9 IF +$DATA(@TIUY@("INDX",DA))
QUIT
+10 ; Selectively filter DELETED or RETRACTED records
+11 IF +$PIECE($GET(^TIU(8925,DA,0)),U,5)>13
IF '+$$CANDO^TIULP(DA,"VIEW",DUZ)
QUIT
+12 SET TIUI=$SELECT(SEQUENCE="D":+$GET(TIUI)+1,1:+$GET(TIUI)-1)
+13 SET @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
+14 SET TIUJ=+$GET(TIUJ)+1
+15 SET @TIUY@("INDX",DA,TIUI)=""
+16 IF +$GET(SHOWADD)=0
QUIT
+17 IF +$$HASDAD^TIUSRVLI(DA)
DO SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
+18 IF +$$HASKIDS^TIUSRVLI(DA)
DO SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
ACLAU(TIUY,CLASS,AUTHOR,DFN,TIME1,TIME2,SEQUENCE,INCUND) ; Unsigned
+1 NEW DATTIM,DA,ROOT,TIUI
+2 SET ROOT=$NAME(^TIU(8925,"ACLAU",CLASS,AUTHOR,DFN))
+3 SET DATTIM=TIME1-.0000001
+4 FOR
SET DATTIM=$ORDER(@ROOT@(DATTIM))
IF DATTIM'>0!(DATTIM>TIME2)
QUIT
Begin DoDot:1
+5 SET DA=0
FOR
SET DA=$ORDER(@ROOT@(DATTIM,DA))
IF DA'>0
QUIT
Begin DoDot:2
+6 IF +$GET(^TIU(8925,+DA,0))'>0
KILL @ROOT@(DATTIM,DA)
QUIT
+7 IF +$PIECE($GET(^TIU(8925,DA,0)),U,5)>6
KILL @ROOT@(DATTIM,DA)
QUIT
+8 SET TIUI=$SELECT(SEQUENCE="D":+$GET(TIUI)+1,1:+$GET(TIUI)-1)
+9 IF +$DATA(@TIUY@("INDX",DA))
QUIT
+10 ; Selectively filter DELETED or RETRACTED records
+11 IF +$PIECE($GET(^TIU(8925,DA,0)),U,5)>13
IF '+$$CANDO^TIULP(DA,"VIEW",DUZ)
QUIT
+12 SET @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
+13 SET @TIUY@("INDX",DA,TIUI)=""
+14 IF +$GET(SHOWADD)=0
QUIT
+15 IF +$$HASDAD^TIUSRVLI(DA)
DO SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
+16 IF +$$HASKIDS^TIUSRVLI(DA)
DO SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
End DoDot:2
End DoDot:1
+17 IF +$GET(INCUND)
DO GETUND^TIUSRVLI(.TIUY,CLASS,DFN,TIME1,TIME2,.TIUI,SEQUENCE)
+18 QUIT
+19 ;
ACLEC(TIUY,CLASS,EXCOSIGN,DFN,TIME1,TIME2,SEQUENCE) ; Uncosigned
+1 NEW DATTIM,DA,ROOT,TIUI
+2 SET ROOT=$NAME(^TIU(8925,"ACLEC",CLASS,EXCOSIGN,DFN))
+3 SET DATTIM=TIME1-.0000001
+4 FOR
SET DATTIM=$ORDER(@ROOT@(DATTIM))
IF DATTIM'>0!(DATTIM>TIME2)
QUIT
Begin DoDot:1
+5 SET DA=0
FOR
SET DA=$ORDER(@ROOT@(DATTIM,DA))
IF DA'>0
QUIT
Begin DoDot:2
+6 IF +$GET(^TIU(8925,+DA,0))'>0
KILL @ROOT@(DATTIM,DA)
QUIT
+7 SET TIUI=$SELECT(SEQUENCE="D":+$GET(TIUI)+1,1:+$GET(TIUI)-1)
+8 IF +$DATA(@TIUY@("INDX",DA))
QUIT
+9 ; Selectively filter DELETED or RETRACTED records
+10 IF +$PIECE($GET(^TIU(8925,DA,0)),U,5)>13
IF '+$$CANDO^TIULP(DA,"VIEW",DUZ)
QUIT
+11 SET @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
+12 SET @TIUY@("INDX",DA,TIUI)=""
+13 IF +$GET(SHOWADD)=0
QUIT
+14 IF +$$HASDAD^TIUSRVLI(DA)
DO SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
+15 IF +$$HASKIDS^TIUSRVLI(DA)
DO SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
ACLSB(TIUY,CLASS,SIGNEDBY,DFN,TIME1,TIME2,SEQUENCE) ; Signed, by author
+1 NEW DATTIM,DA,ROOT,TIUI
+2 SET ROOT=$NAME(^TIU(8925,"ACLSB",CLASS,SIGNEDBY,DFN))
+3 SET DATTIM=TIME1-.0000001
+4 FOR
SET DATTIM=$ORDER(@ROOT@(DATTIM))
IF DATTIM'>0!(DATTIM>TIME2)
QUIT
Begin DoDot:1
+5 SET DA=0
FOR
SET DA=$ORDER(@ROOT@(DATTIM,DA))
IF DA'>0
QUIT
Begin DoDot:2
+6 IF +$GET(^TIU(8925,+DA,0))'>0
KILL @ROOT@(DATTIM,DA)
QUIT
+7 SET TIUI=$SELECT(SEQUENCE="D":+$GET(TIUI)+1,1:+$GET(TIUI)-1)
+8 IF +$DATA(@TIUY@("INDX",DA))
QUIT
+9 ; Selectively filter DELETED or RETRACTED records
+10 IF +$PIECE($GET(^TIU(8925,DA,0)),U,5)>13
IF '+$$CANDO^TIULP(DA,"VIEW",DUZ)
QUIT
+11 SET @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
+12 SET @TIUY@("INDX",DA,TIUI)=""
+13 IF +$GET(SHOWADD)=0
QUIT
+14 IF +$$HASDAD^TIUSRVLI(DA)
DO SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
+15 IF +$$HASKIDS^TIUSRVLI(DA)
DO SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
RESOLVE(DA) ; Resolve to external data
+1 NEW DOC,LOC,PT,AUT,EDT,TIUPT,TIULST4,TIUREC,TIUR0,TIUR12,TIUR13,TIUR14
+2 NEW TIUR17,STATUS,EDTCNT,LOCTYP,TIUADT,TIUDDT,PREFIX,IDPARENT,IDSORT
+3 SET PREFIX=""
+4 SET TIUR0=$GET(^TIU(8925,+DA,0))
SET TIUR12=$GET(^TIU(8925,+DA,12))
+5 SET TIUR13=$GET(^TIU(8925,+DA,13))
SET TIUR14=$GET(^(14))
SET TIUR17=$GET(^(17))
+6 SET IDPARENT=+$GET(^TIU(8925,+DA,21))
+7 SET TIUPT=$GET(^DPT(+$PIECE(TIUR0,U,2),0))
+8 SET DOC=$$PNAME^TIULC1(+TIUR0)
+9 IF +$GET(^TIU(8925.1,+DA,15))
Begin DoDot:1
+10 NEW TIUD15
SET TIUD15=$GET(^TIU(8925.1,+DA,15))
+11 SET DOC=DOC_";"_$PIECE($GET(^TIU(8926.1,+TIUD15,0)),U)
End DoDot:1
+12 IF DOC="Addendum"
SET DOC=DOC_" to "_$$PNAME^TIULC1(+$GET(^TIU(8925,+$PIECE(TIUR0,U,6),0)))
+13 ; If IDNotes (TIU*1.0*100) installed, use $$PREFIX^TIULA2 to evaluate
+14 ; which prefix to use:
+15 ; - keep prefix display in earlier CPRS versions and LM
+16 ; - omit in newer TreeView versions
+17 IF $LENGTH($TEXT(PREFIX^TIULA2))
Begin DoDot:1
+18 ; 1=include ID Child indicator
SET PREFIX=$$PREFIX^TIULA2(DA,1)
+19 IF PREFIX["<"
SET IDSORT=$$IDSORT(DA)
+20 IF +$GET(SHOWADD)=0
SET DOC=PREFIX_DOC
End DoDot:1
IF 1
+21 ; otherwise, only show addendum indicator (+)
+22 ; - keep prefix display in earlier CPRS versions and LM
+23 ; - omit in newer TreeView versions
+24 IF '$TEST
Begin DoDot:1
+25 IF +$$HASADDEN^TIULC1(DA)
SET PREFIX="+ "
+26 IF +$GET(SHOWADD)=0
IF (+$$HASADDEN^TIULC1(DA))
SET DOC=PREFIX_DOC
End DoDot:1
+27 IF +$$URGENCY^TIURM(+DA)=1
SET DOC=$SELECT(DOC["+":"*",1:"* ")_DOC
+28 SET STATUS=$$LOWER^TIULS($PIECE($GET(^TIU(8925.6,+$PIECE(TIUR0,U,5),0)),U))
+29 SET LOC=$GET(^SC(+$PIECE(TIUR12,U,5),0))
SET LOCTYP=$PIECE(LOC,U,3)
SET LOC=$PIECE(LOC,U)
+30 SET TIUADT=$SELECT(LOCTYP="W":"Adm: ",1:"Visit: ")_$$DATE^TIULS($PIECE(TIUR0,U,7),"MM/DD/YY")
+31 SET TIUDDT=$SELECT(+$PIECE(TIUR0,U,8):"Dis: ",1:"")_$$DATE^TIULS($PIECE(TIUR0,U,8),"MM/DD/YY")
+32 IF +$GET(SHOWADD)>0
SET TIUADT=TIUADT_";"_$PIECE(TIUR0,U,7)
SET TIUDDT=TIUDDT_";"_$PIECE(TIUR0,U,8)
+33 SET PT=$$NAME^TIULS($PIECE(TIUPT,U),"LAST, FIRST MI")
+34 SET TIULST4=$EXTRACT($PIECE(TIUPT,U,9),6,9)
+35 SET TIULST4="("_$EXTRACT(PT)_TIULST4_")"
+36 SET AUT=+$PIECE(TIUR12,U,2)
+37 SET AUT=AUT_";"_$$SIGNAME^TIULS(+$PIECE(TIUR12,U,2))_";"_$$GET1^DIQ(200,AUT,.01)
+38 SET EDT=+TIUR13
SET EDTCNT=+$GET(EDTCNT)+1
+39 SET TIUREC=DOC_U_EDT_U_PT_" "_TIULST4_U_AUT_U_LOC_U_STATUS_U_TIUADT_U_TIUDDT_U_$PIECE(TIUR14,U,5)_U_$$IMGCNT(DA)_U
+40 SET TIUREC=TIUREC_$SELECT($LENGTH(TIUR17):$EXTRACT(TIUR17,1,(255-$LENGTH(TIUREC)))_U,1:U)
+41 SET TIUREC=TIUREC_$PIECE(PREFIX," ")_U
+42 SET TIUREC=TIUREC_$SELECT(+TIUR0=81:+$PIECE(TIUR0,U,6),+IDPARENT:IDPARENT,+$GET(CONTEXT):CONTEXT,1:1)_U_$GET(IDSORT)
+43 QUIT $GET(TIUREC)
IMGCNT(TIUDA) ; Get the number of images associated with a document
+1 NEW IMGDA,TIUI
SET (IMGDA,TIUI)=0
+2 FOR
SET IMGDA=$ORDER(^TIU(8925.91,"ADI",TIUDA,IMGDA))
IF +IMGDA'>0
QUIT
Begin DoDot:1
+3 SET TIUI=TIUI+1
End DoDot:1
+4 QUIT TIUI
IDSORT(TIUDA) ; Get ID Sort indicator when appropriate
+1 NEW TIUDPRM
+2 DO DOCPRM^TIULC1(+$GET(^TIU(8925,+TIUDA,0)),.TIUDPRM)
+3 QUIT +$PIECE(TIUDPRM(0),U,18)
