- 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 Feb 19, 2025@00:12:24 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