TIUQRYL ; SLC/JER - Library calls for Query ;11-OCT-2002 16:56
;;1.0;TEXT INTEGRATION UTILITIES;**150**;Jun 20, 1997
RESOLVE(TIUY,DA,QRY,PATIENT) ; Resolve to external data
N TIUR0,TIUR12,TIUR13,TIUR14,TIUR17,TIUR150
N IDPARENT,DOC
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 TIUR150=$G(^TIU(8925,+DA,150))
S IDPARENT=+$G(^TIU(8925,+DA,21))
M @TIUY@("DOC:"_DA)=PATIENT
S (DOC,@TIUY@("DOC:"_DA,"Document.Title"))=$$PNAME^TIULC1(+TIUR0)
S:DOC="Addendum" @TIUY@("DOC:"_DA,"Document.Title")=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUR0,U,6),0)))
; ** If prefix becomes an issue, remove comments and finish implementation **
; 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^TIUSRVLO(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 @TIUY@("DOC:"_DA,"Document.Reference")=+TIUR13
S @TIUY@("DOC:"_DA,"Document.Status")=$$LOWER^TIULS($P($G(^TIU(8925.6,+$P(TIUR0,U,5),0)),U))
S @TIUY@("DOC:"_DA,"Document.Author")=$S(+$P(TIUR12,U,2):$$PERSNAME^TIULC1($P(TIUR12,U,2)),1:"")
S @TIUY@("DOC:"_DA,"Document.Cosigner")=$S(+$P(TIUR12,U,8):$$PERSNAME^TIULC1($P(TIUR12,U,8)),1:"")
Q
;
SETDAD(TIUY,DA,QRY,PATIENT) ; 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
D RESOLVE(TIUY,DADA,.QRY,.PATIENT)
S @TIUY@("INDX",DADA)=""
I +$G(SHOWADD) D SETKIDS(TIUY,DADA,.QRY,.PATIENT)
I +$$HASDAD^TIUSRVLI(DADA) D SETDAD(TIUY,DADA,.QRY,.PATIENT)
Q
;
SETKIDS(TIUY,DA,QRY,PATIENT) ; 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))
. D RESOLVE(TIUY,KIDA,.QRY,.PATIENT)
. S @TIUY@("INDX",KIDA)=""
; 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))
. D RESOLVE(TIUY,KIDA,.QRY,.PATIENT)
. S @TIUY@("INDX",KIDA)=""
. I +$$HASKIDS^TIUSRVLI(KIDA) D SETKIDS(TIUY,KIDA,.QRY,.PATIENT)
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUQRYL 2999 printed Apr 09, 2024@21:48:54 Page 2
TIUQRYL ; SLC/JER - Library calls for Query ;11-OCT-2002 16:56
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**150**;Jun 20, 1997
RESOLVE(TIUY,DA,QRY,PATIENT) ; Resolve to external data
+1 NEW TIUR0,TIUR12,TIUR13,TIUR14,TIUR17,TIUR150
+2 NEW IDPARENT,DOC
+3 SET TIUR0=$GET(^TIU(8925,+DA,0))
SET TIUR12=$GET(^TIU(8925,+DA,12))
+4 SET TIUR13=$GET(^TIU(8925,+DA,13))
SET TIUR14=$GET(^(14))
SET TIUR17=$GET(^(17))
+5 SET TIUR150=$GET(^TIU(8925,+DA,150))
+6 SET IDPARENT=+$GET(^TIU(8925,+DA,21))
+7 MERGE @TIUY@("DOC:"_DA)=PATIENT
+8 SET (DOC,@TIUY@("DOC:"_DA,"Document.Title"))=$$PNAME^TIULC1(+TIUR0)
+9 if DOC="Addendum"
SET @TIUY@("DOC:"_DA,"Document.Title")=DOC_" to "_$$PNAME^TIULC1(+$GET(^TIU(8925,+$PIECE(TIUR0,U,6),0)))
+10 ; ** If prefix becomes an issue, remove comments and finish implementation **
+11 ; If IDNotes (TIU*1.0*100) installed, use $$PREFIX^TIULA2 to evaluate
+12 ; which prefix to use:
+13 ; - keep prefix display in earlier CPRS versions and LM
+14 ; - omit in newer TreeView versions
+15 ;I $L($T(PREFIX^TIULA2)) D I 1
+16 ;. S PREFIX=$$PREFIX^TIULA2(DA,1) ; 1=include ID Child indicator
+17 ;. I PREFIX["<" S IDSORT=$$IDSORT^TIUSRVLO(DA)
+18 ;. I +$G(SHOWADD)=0 S DOC=PREFIX_DOC
+19 ; otherwise, only show addendum indicator (+)
+20 ; - keep prefix display in earlier CPRS versions and LM
+21 ; - omit in newer TreeView versions
+22 ;E D
+23 ;. I +$$HASADDEN^TIULC1(DA) S PREFIX="+ "
+24 ;. I +$G(SHOWADD)=0,(+$$HASADDEN^TIULC1(DA)) S DOC=PREFIX_DOC
+25 ;I +$$URGENCY^TIURM(+DA)=1 S DOC=$S(DOC["+":"*",1:"* ")_DOC
+26 ; **
+27 SET @TIUY@("DOC:"_DA,"Document.Reference")=+TIUR13
+28 SET @TIUY@("DOC:"_DA,"Document.Status")=$$LOWER^TIULS($PIECE($GET(^TIU(8925.6,+$PIECE(TIUR0,U,5),0)),U))
+29 SET @TIUY@("DOC:"_DA,"Document.Author")=$SELECT(+$PIECE(TIUR12,U,2):$$PERSNAME^TIULC1($PIECE(TIUR12,U,2)),1:"")
+30 SET @TIUY@("DOC:"_DA,"Document.Cosigner")=$SELECT(+$PIECE(TIUR12,U,8):$$PERSNAME^TIULC1($PIECE(TIUR12,U,8)),1:"")
+31 QUIT
+32 ;
SETDAD(TIUY,DA,QRY,PATIENT) ; 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 DO RESOLVE(TIUY,DADA,.QRY,.PATIENT)
+10 SET @TIUY@("INDX",DADA)=""
+11 IF +$GET(SHOWADD)
DO SETKIDS(TIUY,DADA,.QRY,.PATIENT)
+12 IF +$$HASDAD^TIUSRVLI(DADA)
DO SETDAD(TIUY,DADA,.QRY,.PATIENT)
+13 QUIT
+14 ;
SETKIDS(TIUY,DA,QRY,PATIENT) ; 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 DO RESOLVE(TIUY,KIDA,.QRY,.PATIENT)
+7 SET @TIUY@("INDX",KIDA)=""
End DoDot:1
+8 ; Next do ID entries
+9 SET KIDA=0
+10 FOR
SET KIDA=$ORDER(^TIU(8925,"GDAD",DA,KIDA))
if +KIDA'>0
QUIT
Begin DoDot:1
+11 if +$DATA(@TIUY@("INDX",KIDA))
QUIT
+12 DO RESOLVE(TIUY,KIDA,.QRY,.PATIENT)
+13 SET @TIUY@("INDX",KIDA)=""
+14 IF +$$HASKIDS^TIUSRVLI(KIDA)
DO SETKIDS(TIUY,KIDA,.QRY,.PATIENT)
End DoDot:1
+15 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
