TIUSRVLO ;SLC/JER - Server fns - lists for CPRS ;Apr 06, 2021@11:27:34
;;1.0;TEXT INTEGRATION UTILITIES;**1,15,19,63,108,122,181,194,211,268,287,339**;Jun 20, 1997;Build 39
;
; AWCMCPR1 DBIA #4325
;
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,SHOW,TIUIEN) ; 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
; SHOW - Boolean: Return "0^SHOW MORE" in return
; array when additional notes available for
; context of 1 or 5 when occurrence limit
; prevents all notes from displaying
; TIUIEN - Starting TIU IEN for additional return
; when "SHOW MORE" was received in previous
; return array (LATE date/time will be set
; to Reference date of this TIU document)
;
S TIUY=$NA(^TMP("TIUR",$J))
K @TIUY
I $G(CONTEXT)'>0 Q
I $G(CLASS)'>0 Q
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 +$G(TIUIEN)>0,(CONTEXT=1!(CONTEXT=5)) S LATE=$P($G(^TIU(8925,+TIUIEN,13)),U,1) I EARLY>LATE Q
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,+$G(SHOW),$G(TIUIEN))
;
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
. . 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,SHOW,TIUIEN) ; Signed, by patient
N DATTIM,DA,LSTDA,NGD,PRVRTNDT,ROOT,STRTDT,TIUI,TIUJ,TIUP,OCCLIM2
S (LSTDA,NGD,STRTDT)=0
I +TIUIEN>0 D
. S NGD=1
. S STRTDT=9999999-TIME1
. S PRVRTNDT=0
S OCCLIM2=OCCLIM,OCCLIM=OCCLIM+1
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 Q:+$G(TIUJ)'<OCCLIM
. S DA=0 F S DA=$O(@ROOT@(DATTIM,DA)) Q:DA'>0 Q:+$G(TIUJ)'<OCCLIM D
. . I NGD=1 D Q ;If grabbing additional entries, don't return any before the one sent in or the sent in one as the starting point
. . . I DA=TIUIEN D ;Reached starting point, everything after is valid to return
. . . . S NGD=0
. . . . S PRVRTNDT=9999999-DATTIM
. . . . Q
. . . Q
. . ;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
. . ; Selectively filter DELETED or RETRACTED records
. . I +$P($G(^TIU(8925,DA,0)),U,5)>13,'+$$CANDO^TIULP(DA,"VIEW",DUZ) Q
. . I +$D(@TIUY@("INDX",DA)) S LSTDA=DA Q
. . I TIUJ'<OCCLIM2 S OCCLIM=OCCLIM2 Q
. . S LSTDA=DA
. . S TIUI=$S(SEQUENCE="D":+$G(TIUI)+1,1:+$G(TIUI)-1)
. . S @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
. . I '+$D(@TIUY@("INDX",+$P($G(^TIU(8925,+DA,0)),U,6))),'+$D(@TIUY@("INDX",+$G(^TIU(8925,+DA,21)))) S TIUJ=+$G(TIUJ)+1
. . S @TIUY@("INDX",DA,TIUI)=""
. . Q:+$G(SHOWADD)=0
. . S TIUP=+$$HASDAD^TIUSRVLI(DA) I TIUP D D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI,1)
. . . N TIUPT
. . . S TIUPT=$P($G(^TIU(8925,+DA,0)),"^",6)
. . . I TIUPT]"",'$D(^TIU(8925,"DAD",TIUPT,DA)) S ^TIU(8925,"DAD",TIUPT,DA)=""
. . . I TIUPT="" S TIUPT=$G(^TIU(8925,+DA,21))
. . . I '$D(^TIU(8925,TIUPT,0)) S $P(@TIUY@(TIUI),"^",16)=1,$P(@TIUY@(TIUI),"^",14)=1 Q
. . I +$$HASKIDS^TIUSRVLI(DA) D
. . . ;ADD IF PREVIOUS RETURN THEN REMOVE ENTRY CODE
. . . D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI,1)
I +TIUIEN>0 D RESEQ^TIUSRVLI(.TIUY,.TIUI)
I +SHOW>0,+DATTIM>0,+DATTIM'>TIME2,+$G(TIUJ)'<OCCLIM D
. S DA=LSTDA ;+$G(@TIUY@(TIUI))
. S TIUI=$S(SEQUENCE="D":+$G(TIUI)+1,1:+$G(TIUI)-1)
. N LSTDT S LSTDT=+$G(^TIU(8925,+DA,13)) I LSTDT'>0 S LSTDT=""
. S @TIUY@(TIUI)=DA_"^SHOW MORE^"_LSTDT_"^^^^^^^^^^^"_$S(+$G(CONTEXT):CONTEXT,1:1)_"^"
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
. . S TIUP=+$$HASDAD^TIUSRVLI(DA) I TIUP D D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI,0)
. . . N TIUPT
. . . S TIUPT=$P($G(^TIU(8925,+DA,0)),"^",6)
. . . I TIUPT]"",'$D(^TIU(8925,"DAD",TIUPT,DA)) S ^TIU(8925,"DAD",TIUPT,DA)=""
. . . I TIUPT="" S TIUPT=$G(^TIU(8925,+DA,21))
. . . I '$D(^TIU(8925,TIUPT,0)) S $P(@TIUY@(TIUI),"^",16)=1,$P(@TIUY@(TIUI),"^",14)=2 Q
. . I +$$HASKIDS^TIUSRVLI(DA) D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI,0)
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
. . S TIUP=+$$HASDAD^TIUSRVLI(DA) I TIUP D D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI,0)
. . . N TIUPT
. . . S TIUPT=$P($G(^TIU(8925,+DA,0)),"^",6)
. . . I TIUPT]"",'$D(^TIU(8925,"DAD",TIUPT,DA)) S ^TIU(8925,"DAD",TIUPT,DA)=""
. . . I TIUPT="" S TIUPT=$G(^TIU(8925,+DA,21))
. . . I '$D(^TIU(8925,TIUPT,0)) S $P(@TIUY@(TIUI),"^",16)=1,$P(@TIUY@(TIUI),"^",14)=3 Q
. . I +$$HASKIDS^TIUSRVLI(DA) D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI,0)
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
. . . S TIUP=+$$HASDAD^TIUSRVLI(DA) I TIUP D D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI,0)
. . . N TIUPT
. . . S TIUPT=$P($G(^TIU(8925,+DA,0)),"^",6)
. . . I TIUPT]"",'$D(^TIU(8925,"DAD",TIUPT,DA)) S ^TIU(8925,"DAD",TIUPT,DA)=""
. . . I TIUPT="" S TIUPT=$G(^TIU(8925,+DA,21))
. . . I '$D(^TIU(8925,TIUPT,0)) S $P(@TIUY@(TIUI),"^",16)=1,$P(@TIUY@(TIUI),"^",14)=1 Q
. . I +$$HASKIDS^TIUSRVLI(DA) D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI,0)
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=$TR($$PNAME^TIULC1(+TIUR0),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
S DOC=$$PNAME^TIULC1(+TIUR0)
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)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUSRVLO 12623 printed Oct 16, 2024@18:46:28 Page 2
TIUSRVLO ;SLC/JER - Server fns - lists for CPRS ;Apr 06, 2021@11:27:34
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1,15,19,63,108,122,181,194,211,268,287,339**;Jun 20, 1997;Build 39
+2 ;
+3 ; AWCMCPR1 DBIA #4325
+4 ;
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,SHOW,TIUIEN) ; 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 ; SHOW - Boolean: Return "0^SHOW MORE" in return
+17 ; array when additional notes available for
+18 ; context of 1 or 5 when occurrence limit
+19 ; prevents all notes from displaying
+20 ; TIUIEN - Starting TIU IEN for additional return
+21 ; when "SHOW MORE" was received in previous
+22 ; return array (LATE date/time will be set
+23 ; to Reference date of this TIU document)
+24 ;
+25 SET TIUY=$NAME(^TMP("TIUR",$JOB))
+26 KILL @TIUY
+27 IF $GET(CONTEXT)'>0
QUIT
+28 IF $GET(CLASS)'>0
QUIT
+29 ; TIU*1.0*181
IF $GET(CONTEXT)=1
DO STRT1^AWCMCPR1
+30 if +$GET(EARLY)'>0!(+$GET(CONTEXT)=1)
SET EARLY=0
+31 if +$GET(LATE)'>0!(+$GET(CONTEXT)=1)
SET LATE=5000000
+32 IF EARLY>LATE
DO SWAP(.EARLY,.LATE)
+33 IF +$GET(TIUIEN)>0
IF (CONTEXT=1!(CONTEXT=5))
SET LATE=$PIECE($GET(^TIU(8925,+TIUIEN,13)),U,1)
IF EARLY>LATE
QUIT
+34 IF $LENGTH(LATE,".")=1
DO EXPRANGE(.EARLY,.LATE)
+35 if +$GET(PERSON)'>0
SET PERSON=DUZ
+36 if $GET(SEQUENCE)']""
SET SEQUENCE="D"
+37 if +$GET(OCCLIM)'>0
SET OCCLIM=9999999
+38 SET DFN=+$GET(DFN)
+39 ; CHANGE TO REVERSE DATES
SET EARLY=9999999-EARLY
SET LATE=9999999-LATE
+40 ;
+41 IF CONTEXT=1!(CONTEXT=5)
Begin DoDot:1
+42 DO ACLPT(.TIUY,CLASS,DFN,LATE,EARLY,OCCLIM,SEQUENCE,+$GET(SHOW),$GET(TIUIEN))
End DoDot:1
GOTO CTXQ
+43 ;
+44 IF CONTEXT=2
Begin DoDot:1
+45 IF DFN>0
Begin DoDot:2
+46 DO ACLAU(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE,$GET(INCUND))
End DoDot:2
QUIT
+47 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
+48 ;
+49 IF CONTEXT=3
Begin DoDot:1
+50 IF DFN>0
Begin DoDot:2
+51 DO ACLEC(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
End DoDot:2
QUIT
+52 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
+53 ;
+54 IF CONTEXT=4
Begin DoDot:1
+55 IF DFN>0
Begin DoDot:2
+56 DO APTCL^TIUSRVLP(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
End DoDot:2
QUIT
+57 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
+58 ;
CTXQ ;
+1 KILL @TIUY@("INDX")
+2 ; TIU*1.0*181
IF $DATA(AWCSTRT)
DO END^AWCMCPR1
+3 QUIT
+4 ;
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,SHOW,TIUIEN) ; Signed, by patient
+1 NEW DATTIM,DA,LSTDA,NGD,PRVRTNDT,ROOT,STRTDT,TIUI,TIUJ,TIUP,OCCLIM2
+2 SET (LSTDA,NGD,STRTDT)=0
+3 IF +TIUIEN>0
Begin DoDot:1
+4 SET NGD=1
+5 SET STRTDT=9999999-TIME1
+6 SET PRVRTNDT=0
End DoDot:1
+7 SET OCCLIM2=OCCLIM
SET OCCLIM=OCCLIM+1
+8 SET ROOT=$NAME(^TIU(8925,"ACLPT",CLASS,DFN))
SET TIUJ=0
+9 SET DATTIM=TIME1-.0000001
+10 FOR
SET DATTIM=$ORDER(@ROOT@(DATTIM))
if $SELECT(+DATTIM'>0
QUIT
Begin DoDot:1
+11 SET DA=0
FOR
SET DA=$ORDER(@ROOT@(DATTIM,DA))
if DA'>0
QUIT
if +$GET(TIUJ)'<OCCLIM
QUIT
Begin DoDot:2
+12 ;If grabbing additional entries, don't return any before the one sent in or the sent in one as the starting point
IF NGD=1
Begin DoDot:3
+13 ;Reached starting point, everything after is valid to return
IF DA=TIUIEN
Begin DoDot:4
+14 SET NGD=0
+15 SET PRVRTNDT=9999999-DATTIM
+16 QUIT
End DoDot:4
+17 QUIT
End DoDot:3
QUIT
+18 ;Added first condition to following line for interdisciplinary notes - need addenda
+19 IF +$GET(SHOWADD)=0
IF (+$GET(^TIU(8925,+DA,0))=81)
QUIT
+20 IF +$GET(^TIU(8925,+DA,0))'>0
KILL @ROOT@(DATTIM,DA)
QUIT
+21 ; Selectively filter DELETED or RETRACTED records
+22 IF +$PIECE($GET(^TIU(8925,DA,0)),U,5)>13
IF '+$$CANDO^TIULP(DA,"VIEW",DUZ)
QUIT
+23 IF +$DATA(@TIUY@("INDX",DA))
SET LSTDA=DA
QUIT
+24 IF TIUJ'<OCCLIM2
SET OCCLIM=OCCLIM2
QUIT
+25 SET LSTDA=DA
+26 SET TIUI=$SELECT(SEQUENCE="D":+$GET(TIUI)+1,1:+$GET(TIUI)-1)
+27 SET @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
+28 IF '+$DATA(@TIUY@("INDX",+$PIECE($GET(^TIU(8925,+DA,0)),U,6)))
IF '+$DATA(@TIUY@("INDX",+$GET(^TIU(8925,+DA,21))))
SET TIUJ=+$GET(TIUJ)+1
+29 SET @TIUY@("INDX",DA,TIUI)=""
+30 if +$GET(SHOWADD)=0
QUIT
+31 SET TIUP=+$$HASDAD^TIUSRVLI(DA)
IF TIUP
Begin DoDot:3
+32 NEW TIUPT
+33 SET TIUPT=$PIECE($GET(^TIU(8925,+DA,0)),"^",6)
+34 IF TIUPT]""
IF '$DATA(^TIU(8925,"DAD",TIUPT,DA))
SET ^TIU(8925,"DAD",TIUPT,DA)=""
+35 IF TIUPT=""
SET TIUPT=$GET(^TIU(8925,+DA,21))
+36 IF '$DATA(^TIU(8925,TIUPT,0))
SET $PIECE(@TIUY@(TIUI),"^",16)=1
SET $PIECE(@TIUY@(TIUI),"^",14)=1
QUIT
End DoDot:3
DO SETDAD^TIUSRVLI(.TIUY,DA,.TIUI,1)
+37 IF +$$HASKIDS^TIUSRVLI(DA)
Begin DoDot:3
+38 ;ADD IF PREVIOUS RETURN THEN REMOVE ENTRY CODE
+39 DO SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI,1)
End DoDot:3
End DoDot:2
End DoDot:1
if +$GET(TIUJ)'<OCCLIM
QUIT
+40 IF +TIUIEN>0
DO RESEQ^TIUSRVLI(.TIUY,.TIUI)
+41 IF +SHOW>0
IF +DATTIM>0
IF +DATTIM'>TIME2
IF +$GET(TIUJ)'<OCCLIM
Begin DoDot:1
+42 ;+$G(@TIUY@(TIUI))
SET DA=LSTDA
+43 SET TIUI=$SELECT(SEQUENCE="D":+$GET(TIUI)+1,1:+$GET(TIUI)-1)
+44 NEW LSTDT
SET LSTDT=+$GET(^TIU(8925,+DA,13))
IF LSTDT'>0
SET LSTDT=""
+45 SET @TIUY@(TIUI)=DA_"^SHOW MORE^"_LSTDT_"^^^^^^^^^^^"_$SELECT(+$GET(CONTEXT):CONTEXT,1:1)_"^"
End DoDot:1
+46 QUIT
+47 ;
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 SET TIUP=+$$HASDAD^TIUSRVLI(DA)
IF TIUP
Begin DoDot:3
+16 NEW TIUPT
+17 SET TIUPT=$PIECE($GET(^TIU(8925,+DA,0)),"^",6)
+18 IF TIUPT]""
IF '$DATA(^TIU(8925,"DAD",TIUPT,DA))
SET ^TIU(8925,"DAD",TIUPT,DA)=""
+19 IF TIUPT=""
SET TIUPT=$GET(^TIU(8925,+DA,21))
+20 IF '$DATA(^TIU(8925,TIUPT,0))
SET $PIECE(@TIUY@(TIUI),"^",16)=1
SET $PIECE(@TIUY@(TIUI),"^",14)=2
QUIT
End DoDot:3
DO SETDAD^TIUSRVLI(.TIUY,DA,.TIUI,0)
+21 IF +$$HASKIDS^TIUSRVLI(DA)
DO SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI,0)
End DoDot:2
End DoDot:1
+22 IF +$GET(INCUND)
DO GETUND^TIUSRVLI(.TIUY,CLASS,DFN,TIME1,TIME2,.TIUI,SEQUENCE)
+23 QUIT
+24 ;
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 SET TIUP=+$$HASDAD^TIUSRVLI(DA)
IF TIUP
Begin DoDot:3
+15 NEW TIUPT
+16 SET TIUPT=$PIECE($GET(^TIU(8925,+DA,0)),"^",6)
+17 IF TIUPT]""
IF '$DATA(^TIU(8925,"DAD",TIUPT,DA))
SET ^TIU(8925,"DAD",TIUPT,DA)=""
+18 IF TIUPT=""
SET TIUPT=$GET(^TIU(8925,+DA,21))
+19 IF '$DATA(^TIU(8925,TIUPT,0))
SET $PIECE(@TIUY@(TIUI),"^",16)=1
SET $PIECE(@TIUY@(TIUI),"^",14)=3
QUIT
End DoDot:3
DO SETDAD^TIUSRVLI(.TIUY,DA,.TIUI,0)
+20 IF +$$HASKIDS^TIUSRVLI(DA)
DO SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI,0)
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
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)
Begin DoDot:3
+15 SET TIUP=+$$HASDAD^TIUSRVLI(DA)
IF TIUP
Begin DoDot:4
End DoDot:4
DO SETDAD^TIUSRVLI(.TIUY,DA,.TIUI,0)
+16 NEW TIUPT
+17 SET TIUPT=$PIECE($GET(^TIU(8925,+DA,0)),"^",6)
+18 IF TIUPT]""
IF '$DATA(^TIU(8925,"DAD",TIUPT,DA))
SET ^TIU(8925,"DAD",TIUPT,DA)=""
+19 IF TIUPT=""
SET TIUPT=$GET(^TIU(8925,+DA,21))
+20 IF '$DATA(^TIU(8925,TIUPT,0))
SET $PIECE(@TIUY@(TIUI),"^",16)=1
SET $PIECE(@TIUY@(TIUI),"^",14)=1
QUIT
End DoDot:3
+21 IF +$$HASKIDS^TIUSRVLI(DA)
DO SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI,0)
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
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=$TRANSLATE($$PNAME^TIULC1(+TIUR0),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+9 SET DOC=$$PNAME^TIULC1(+TIUR0)
+10 IF DOC="Addendum"
SET DOC=DOC_" to "_$$PNAME^TIULC1(+$GET(^TIU(8925,+$PIECE(TIUR0,U,6),0)))
+11 ;
+12 ; If IDNotes (TIU*1.0*100) installed, use $$PREFIX^TIULA2 to evaluate
+13 ; which prefix to use:
+14 ; - keep prefix display in earlier CPRS versions and LM
+15 ; - omit in newer TreeView versions
+16 IF $LENGTH($TEXT(PREFIX^TIULA2))
Begin DoDot:1
+17 ; 1=include ID Child indicator
SET PREFIX=$$PREFIX^TIULA2(DA,1)
+18 IF PREFIX["<"
SET IDSORT=$$IDSORT(DA)
+19 IF +$GET(SHOWADD)=0
SET DOC=PREFIX_DOC
End DoDot:1
IF 1
+20 ; otherwise, only show addendum indicator (+)
+21 ; - keep prefix display in earlier CPRS versions and LM
+22 ; - omit in newer TreeView versions
+23 IF '$TEST
Begin DoDot:1
+24 IF +$$HASADDEN^TIULC1(DA)
SET PREFIX="+ "
+25 IF +$GET(SHOWADD)=0
IF (+$$HASADDEN^TIULC1(DA))
SET DOC=PREFIX_DOC
End DoDot:1
+26 IF +$$URGENCY^TIURM(+DA)=1
SET DOC=$SELECT(DOC["+":"*",1:"* ")_DOC
+27 SET STATUS=$$LOWER^TIULS($PIECE($GET(^TIU(8925.6,+$PIECE(TIUR0,U,5),0)),U))
+28 SET LOC=$GET(^SC(+$PIECE(TIUR12,U,5),0))
SET LOCTYP=$PIECE(LOC,U,3)
SET LOC=$PIECE(LOC,U)
+29 SET TIUADT=$SELECT(LOCTYP="W":"Adm: ",1:"Visit: ")_$$DATE^TIULS($PIECE(TIUR0,U,7),"MM/DD/YY")
+30 SET TIUDDT=$SELECT(+$PIECE(TIUR0,U,8):"Dis: ",1:"")_$$DATE^TIULS($PIECE(TIUR0,U,8),"MM/DD/YY")
+31 IF +$GET(SHOWADD)>0
SET TIUADT=TIUADT_";"_$PIECE(TIUR0,U,7)
SET TIUDDT=TIUDDT_";"_$PIECE(TIUR0,U,8)
+32 SET PT=$$NAME^TIULS($PIECE(TIUPT,U),"LAST, FIRST MI")
+33 SET TIULST4=$EXTRACT($PIECE(TIUPT,U,9),6,9)
+34 SET TIULST4="("_$EXTRACT(PT)_TIULST4_")"
+35 SET AUT=+$PIECE(TIUR12,U,2)
+36 SET AUT=AUT_";"_$$SIGNAME^TIULS(+$PIECE(TIUR12,U,2))_";"_$$GET1^DIQ(200,AUT,.01)
+37 SET EDT=+TIUR13
SET EDTCNT=+$GET(EDTCNT)+1
+38 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
+39 SET TIUREC=TIUREC_$SELECT($LENGTH(TIUR17):$EXTRACT(TIUR17,1,(255-$LENGTH(TIUREC)))_U,1:U)
+40 SET TIUREC=TIUREC_$PIECE(PREFIX," ")_U
+41 SET TIUREC=TIUREC_$SELECT(+TIUR0=81:+$PIECE(TIUR0,U,6),+IDPARENT:IDPARENT,+$GET(CONTEXT):CONTEXT,1:1)_U_$GET(IDSORT)
+42 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)
