TIUSRVLR ; SLC/JER - TIU RPCs ; 02/25/04
;;1.0;TEXT INTEGRATION UTILITIES;**112**;Jun 20, 1997
GETDOCS(TIUY,OVP,SEQUENCE) ; Get TIU Documents for a given Consult or
; Surgical Case
N TIUDA,TIUI
;Initialize vars
S (TIUDA,TIUI)=0,TIUY=$NA(^TMP("TIULIST",$J)) K @TIUY
S SEQUENCE=$S($G(SEQUENCE)]"":$G(SEQUENCE),1:"D")
;Loop through "G" X-ref in 8925 to find associated documents
F S TIUDA=$O(^TIU(8925,"G",OVP,TIUDA)) Q:+TIUDA'>0 D
. S TIUI=TIUI+1
. ; Cross-check value of field 1405 with x-ref value
. I OVP'=$P($G(^TIU(8925,TIUDA,14)),U,5) Q
. ; If a document is an ID Entry, get its parent
. ; I +$G(^TIU(8925,TIUDA,21)) S TIUDA=+$G(^TIU(8925,TIUDA,21))
. ; Don't include entry in list more than once
. I +$O(@TIUY@("INDX",TIUDA,0)) Q
. ; Don't include entry in list if RETRACTED
. I $P($G(^TIU(8925,TIUDA,0)),U,5)=15 Q
. S @TIUY@(TIUI)=TIUDA_U_$$RESOLVE^TIUSRVLO(TIUDA)
. S @TIUY@("INDX",TIUDA,TIUI)=""
. I +$$HASDAD^TIUSRVLI(TIUDA) D SETDAD^TIUSRVLI(.TIUY,TIUDA,.TIUI)
. I +$$HASKIDS^TIUSRVLI(TIUDA) D SETKIDS^TIUSRVLI(.TIUY,TIUDA,.TIUI)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUSRVLR 1090 printed Oct 16, 2024@18:46:29 Page 2
TIUSRVLR ; SLC/JER - TIU RPCs ; 02/25/04
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**112**;Jun 20, 1997
GETDOCS(TIUY,OVP,SEQUENCE) ; Get TIU Documents for a given Consult or
+1 ; Surgical Case
+2 NEW TIUDA,TIUI
+3 ;Initialize vars
+4 SET (TIUDA,TIUI)=0
SET TIUY=$NAME(^TMP("TIULIST",$JOB))
KILL @TIUY
+5 SET SEQUENCE=$SELECT($GET(SEQUENCE)]"":$GET(SEQUENCE),1:"D")
+6 ;Loop through "G" X-ref in 8925 to find associated documents
+7 FOR
SET TIUDA=$ORDER(^TIU(8925,"G",OVP,TIUDA))
if +TIUDA'>0
QUIT
Begin DoDot:1
+8 SET TIUI=TIUI+1
+9 ; Cross-check value of field 1405 with x-ref value
+10 IF OVP'=$PIECE($GET(^TIU(8925,TIUDA,14)),U,5)
QUIT
+11 ; If a document is an ID Entry, get its parent
+12 ; I +$G(^TIU(8925,TIUDA,21)) S TIUDA=+$G(^TIU(8925,TIUDA,21))
+13 ; Don't include entry in list more than once
+14 IF +$ORDER(@TIUY@("INDX",TIUDA,0))
QUIT
+15 ; Don't include entry in list if RETRACTED
+16 IF $PIECE($GET(^TIU(8925,TIUDA,0)),U,5)=15
QUIT
+17 SET @TIUY@(TIUI)=TIUDA_U_$$RESOLVE^TIUSRVLO(TIUDA)
+18 SET @TIUY@("INDX",TIUDA,TIUI)=""
+19 IF +$$HASDAD^TIUSRVLI(TIUDA)
DO SETDAD^TIUSRVLI(.TIUY,TIUDA,.TIUI)
+20 IF +$$HASKIDS^TIUSRVLI(TIUDA)
DO SETKIDS^TIUSRVLI(.TIUY,TIUDA,.TIUI)
End DoDot:1
+21 QUIT
