TIUSRVLR.m

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 ---TIUSRVLR   1090     printed  Apr 09, 2024@21:44:22                                                                                                                                                                                                    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