TIUSRVLI ; SLC/JER - Server fns - lists for CPRS ;13-NOV-2001 08:21:33
;;1.0;TEXT INTEGRATION UTILITIES;**108,122**;Jun 20, 1997
HASDAD(DA) ; Evaluate whether a document has a parent
Q $S(+$P($G(^TIU(8925,+DA,0)),U,6):1,+$G(^TIU(8925,+DA,21)):1,1:0)
;
SETDAD(TIUY,DA,TIUI) ; Set parent in return array
N DADA,TIUD0,TIUD21
; Exclude components
Q:'+$$ISDOC(DA)
S TIUD0=$G(^TIU(8925,DA,0)),TIUD21=$G(^(21))
S DADA=$S(+$P(TIUD0,U,6):+$P(TIUD0,U,6),+TIUD21:+TIUD21,1:0)
Q:+DADA'>0
Q:+$D(@TIUY@("INDX",DADA))
Q:+$D(^TIU(8925,DADA,0))=0
S TIUI=$S(SEQUENCE="A":+$G(TIUI)-1,1:+$G(TIUI)+1)
S @TIUY@(TIUI)=DADA_U_$$RESOLVE^TIUSRVLO(DADA)
S @TIUY@("INDX",DADA,TIUI)=""
I +$G(SHOWADD) D SETKIDS(.TIUY,DADA,.TIUI)
I +$$HASDAD(DADA) D SETDAD(.TIUY,DADA,.TIUI)
Q
;
HASKIDS(DA) ; Evaluate whether a document has children
N TIUY,KIDA S (KIDA,TIUY)=0
; Check for addenda
F S KIDA=$O(^TIU(8925,"DAD",DA,KIDA)) Q:+TIUY!(+KIDA'>0) D
. I '+$$ISCOMP^TIUSRVR1(KIDA) S TIUY=1
I +TIUY G HASKIDX
; Next, look for ID Entries
S TIUY=$S(+$O(^TIU(8925,"GDAD",DA,0)):1,1:0)
HASKIDX Q TIUY
;
SETKIDS(TIUY,DA,TIUI) ; Set children in return array
N KIDA S KIDA=0
; Begin with addenda
F S KIDA=$O(^TIU(8925,"DAD",DA,KIDA)) Q:+KIDA'>0 D
. Q:'+$$ISDOC(KIDA)
. Q:+$D(@TIUY@("INDX",KIDA))
. S TIUI=$S(SEQUENCE="A":+$G(TIUI)-1,1:+$G(TIUI)+1)
. S @TIUY@(TIUI)=KIDA_U_$$RESOLVE^TIUSRVLO(KIDA)
. S @TIUY@("INDX",KIDA,TIUI)=""
; Next do ID entries
S KIDA=0
F S KIDA=$O(^TIU(8925,"GDAD",DA,KIDA)) Q:+KIDA'>0 D
. Q:+$D(@TIUY@("INDX",KIDA))
. S TIUI=$S(SEQUENCE="A":+$G(TIUI)-1,1:+$G(TIUI)+1)
. S @TIUY@(TIUI)=KIDA_U_$$RESOLVE^TIUSRVLO(KIDA)
. S @TIUY@("INDX",KIDA,TIUI)=""
. I +$$HASKIDS(KIDA) D SETKIDS(.TIUY,KIDA,.TIUI)
Q
ISDOC(DA) ; Evaluate whether a given record is a document
N TIUY,TIUTYP
S TIUTYP=+$G(^TIU(8925,DA,0))
S TIUY=$S($P($G(^TIU(8925.1,+TIUTYP,0)),U,4)="DOC":1,1:0)
Q TIUY
GETUND(TIUY,CLASS,DFN,TIME1,TIME2,TIUJ,SEQUENCE) ; Get undictated docs
N TIUTYP,TIUI,DATTIM
D DOCTYPE^TIUSRVL(.TIUTYP,CLASS) Q:+$D(TIUTYP)'>9
S TIUI=0
F S TIUI=$O(TIUTYP(TIUI)) Q:+TIUI'>0 D
. N STATUS
. F STATUS=1:1:2 D
. . S DATTIM=TIME1-.0000001
. . F S DATTIM=$O(^TIU(8925,"APT",DFN,+TIUTYP(TIUI),STATUS,DATTIM)) Q:+DATTIM'>0 D
. . . N TIUDA S TIUDA=0
. . . F S TIUDA=$O(^TIU(8925,"APT",DFN,+TIUTYP(TIUI),STATUS,DATTIM,TIUDA)) Q:+TIUDA'>0 D
. . . . Q:+$D(@TIUY@("INDX",TIUDA))
. . . . S TIUJ=$S(SEQUENCE="A":+$G(TIUJ)-1,1:+$G(TIUJ)+1)
. . . . S @TIUY@(TIUJ)=TIUDA_U_$$RESOLVE^TIUSRVLO(TIUDA)
. . . . S @TIUY@("INDX",TIUDA,TIUJ)=""
Q
TIUSRVLI ; SLC/JER - Server fns - lists for CPRS ;13-NOV-2001 08:21:33
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**108,122**;Jun 20, 1997
HASDAD(DA) ; Evaluate whether a document has a parent
+1 QUIT $SELECT(+$PIECE($GET(^TIU(8925,+DA,0)),U,6):1,+$GET(^TIU(8925,+DA,21)):1,1:0)
+2 ;
SETDAD(TIUY,DA,TIUI) ; Set parent in return array
+1 NEW DADA,TIUD0,TIUD21
+2 ; Exclude components
+3 IF '+$$ISDOC(DA)
QUIT
+4 SET TIUD0=$GET(^TIU(8925,DA,0))
SET TIUD21=$GET(^(21))
+5 SET DADA=$SELECT(+$PIECE(TIUD0,U,6):+$PIECE(TIUD0,U,6),+TIUD21:+TIUD21,1:0)
+6 IF +DADA'>0
QUIT
+7 IF +$DATA(@TIUY@("INDX",DADA))
QUIT
+8 IF +$DATA(^TIU(8925,DADA,0))=0
QUIT
+9 SET TIUI=$SELECT(SEQUENCE="A":+$GET(TIUI)-1,1:+$GET(TIUI)+1)
+10 SET @TIUY@(TIUI)=DADA_U_$$RESOLVE^TIUSRVLO(DADA)
+11 SET @TIUY@("INDX",DADA,TIUI)=""
+12 IF +$GET(SHOWADD)
DO SETKIDS(.TIUY,DADA,.TIUI)
+13 IF +$$HASDAD(DADA)
DO SETDAD(.TIUY,DADA,.TIUI)
+14 QUIT
+15 ;
HASKIDS(DA) ; Evaluate whether a document has children
+1 NEW TIUY,KIDA
SET (KIDA,TIUY)=0
+2 ; Check for addenda
+3 FOR
SET KIDA=$ORDER(^TIU(8925,"DAD",DA,KIDA))
IF +TIUY!(+KIDA'>0)
QUIT
Begin DoDot:1
+4 IF '+$$ISCOMP^TIUSRVR1(KIDA)
SET TIUY=1
End DoDot:1
+5 IF +TIUY
GOTO HASKIDX
+6 ; Next, look for ID Entries
+7 SET TIUY=$SELECT(+$ORDER(^TIU(8925,"GDAD",DA,0)):1,1:0)
HASKIDX QUIT TIUY
+1 ;
SETKIDS(TIUY,DA,TIUI) ; Set children in return array
+1 NEW KIDA
SET KIDA=0
+2 ; Begin with addenda
+3 FOR
SET KIDA=$ORDER(^TIU(8925,"DAD",DA,KIDA))
IF +KIDA'>0
QUIT
Begin DoDot:1
+4 IF '+$$ISDOC(KIDA)
QUIT
+5 IF +$DATA(@TIUY@("INDX",KIDA))
QUIT
+6 SET TIUI=$SELECT(SEQUENCE="A":+$GET(TIUI)-1,1:+$GET(TIUI)+1)
+7 SET @TIUY@(TIUI)=KIDA_U_$$RESOLVE^TIUSRVLO(KIDA)
+8 SET @TIUY@("INDX",KIDA,TIUI)=""
End DoDot:1
+9 ; Next do ID entries
+10 SET KIDA=0
+11 FOR
SET KIDA=$ORDER(^TIU(8925,"GDAD",DA,KIDA))
IF +KIDA'>0
QUIT
Begin DoDot:1
+12 IF +$DATA(@TIUY@("INDX",KIDA))
QUIT
+13 SET TIUI=$SELECT(SEQUENCE="A":+$GET(TIUI)-1,1:+$GET(TIUI)+1)
+14 SET @TIUY@(TIUI)=KIDA_U_$$RESOLVE^TIUSRVLO(KIDA)
+15 SET @TIUY@("INDX",KIDA,TIUI)=""
+16 IF +$$HASKIDS(KIDA)
DO SETKIDS(.TIUY,KIDA,.TIUI)
End DoDot:1
+17 QUIT
ISDOC(DA) ; Evaluate whether a given record is a document
+1 NEW TIUY,TIUTYP
+2 SET TIUTYP=+$GET(^TIU(8925,DA,0))
+3 SET TIUY=$SELECT($PIECE($GET(^TIU(8925.1,+TIUTYP,0)),U,4)="DOC":1,1:0)
+4 QUIT TIUY
GETUND(TIUY,CLASS,DFN,TIME1,TIME2,TIUJ,SEQUENCE) ; Get undictated docs
+1 NEW TIUTYP,TIUI,DATTIM
+2 DO DOCTYPE^TIUSRVL(.TIUTYP,CLASS)
IF +$DATA(TIUTYP)'>9
QUIT
+3 SET TIUI=0
+4 FOR
SET TIUI=$ORDER(TIUTYP(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+5 NEW STATUS
+6 FOR STATUS=1:1:2
Begin DoDot:2
+7 SET DATTIM=TIME1-.0000001
+8 FOR
SET DATTIM=$ORDER(^TIU(8925,"APT",DFN,+TIUTYP(TIUI),STATUS,DATTIM))
IF +DATTIM'>0
QUIT
Begin DoDot:3
+9 NEW TIUDA
SET TIUDA=0
+10 FOR
SET TIUDA=$ORDER(^TIU(8925,"APT",DFN,+TIUTYP(TIUI),STATUS,DATTIM,TIUDA))
IF +TIUDA'>0
QUIT
Begin DoDot:4
+11 IF +$DATA(@TIUY@("INDX",TIUDA))
QUIT
+12 SET TIUJ=$SELECT(SEQUENCE="A":+$GET(TIUJ)-1,1:+$GET(TIUJ)+1)
+13 SET @TIUY@(TIUJ)=TIUDA_U_$$RESOLVE^TIUSRVLO(TIUDA)
+14 SET @TIUY@("INDX",TIUDA,TIUJ)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
