| 1 | TIUQRYL ; SLC/JER - Library calls for Query ;11-OCT-2002 16:56
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**150**;Jun 20, 1997
|
|---|
| 3 | RESOLVE(TIUY,DA,QRY,PATIENT) ; Resolve to external data
|
|---|
| 4 | N TIUR0,TIUR12,TIUR13,TIUR14,TIUR17,TIUR150
|
|---|
| 5 | N IDPARENT,DOC
|
|---|
| 6 | S TIUR0=$G(^TIU(8925,+DA,0)),TIUR12=$G(^TIU(8925,+DA,12))
|
|---|
| 7 | S TIUR13=$G(^TIU(8925,+DA,13)),TIUR14=$G(^(14)),TIUR17=$G(^(17))
|
|---|
| 8 | S TIUR150=$G(^TIU(8925,+DA,150))
|
|---|
| 9 | S IDPARENT=+$G(^TIU(8925,+DA,21))
|
|---|
| 10 | M @TIUY@("DOC:"_DA)=PATIENT
|
|---|
| 11 | S (DOC,@TIUY@("DOC:"_DA,"Document.Title"))=$$PNAME^TIULC1(+TIUR0)
|
|---|
| 12 | S:DOC="Addendum" @TIUY@("DOC:"_DA,"Document.Title")=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUR0,U,6),0)))
|
|---|
| 13 | ; ** If prefix becomes an issue, remove comments and finish implementation **
|
|---|
| 14 | ; If IDNotes (TIU*1.0*100) installed, use $$PREFIX^TIULA2 to evaluate
|
|---|
| 15 | ; which prefix to use:
|
|---|
| 16 | ; - keep prefix display in earlier CPRS versions and LM
|
|---|
| 17 | ; - omit in newer TreeView versions
|
|---|
| 18 | ;I $L($T(PREFIX^TIULA2)) D I 1
|
|---|
| 19 | ;. S PREFIX=$$PREFIX^TIULA2(DA,1) ; 1=include ID Child indicator
|
|---|
| 20 | ;. I PREFIX["<" S IDSORT=$$IDSORT^TIUSRVLO(DA)
|
|---|
| 21 | ;. I +$G(SHOWADD)=0 S DOC=PREFIX_DOC
|
|---|
| 22 | ; otherwise, only show addendum indicator (+)
|
|---|
| 23 | ; - keep prefix display in earlier CPRS versions and LM
|
|---|
| 24 | ; - omit in newer TreeView versions
|
|---|
| 25 | ;E D
|
|---|
| 26 | ;. I +$$HASADDEN^TIULC1(DA) S PREFIX="+ "
|
|---|
| 27 | ;. I +$G(SHOWADD)=0,(+$$HASADDEN^TIULC1(DA)) S DOC=PREFIX_DOC
|
|---|
| 28 | ;I +$$URGENCY^TIURM(+DA)=1 S DOC=$S(DOC["+":"*",1:"* ")_DOC
|
|---|
| 29 | ; **
|
|---|
| 30 | S @TIUY@("DOC:"_DA,"Document.Reference")=+TIUR13
|
|---|
| 31 | S @TIUY@("DOC:"_DA,"Document.Status")=$$LOWER^TIULS($P($G(^TIU(8925.6,+$P(TIUR0,U,5),0)),U))
|
|---|
| 32 | S @TIUY@("DOC:"_DA,"Document.Author")=$S(+$P(TIUR12,U,2):$$PERSNAME^TIULC1($P(TIUR12,U,2)),1:"")
|
|---|
| 33 | S @TIUY@("DOC:"_DA,"Document.Cosigner")=$S(+$P(TIUR12,U,8):$$PERSNAME^TIULC1($P(TIUR12,U,8)),1:"")
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | SETDAD(TIUY,DA,QRY,PATIENT) ; Set parent in return array
|
|---|
| 37 | N DADA,TIUD0,TIUD21
|
|---|
| 38 | ; Exclude components
|
|---|
| 39 | Q:'+$$ISDOC(DA)
|
|---|
| 40 | S TIUD0=$G(^TIU(8925,DA,0)),TIUD21=$G(^(21))
|
|---|
| 41 | S DADA=$S(+$P(TIUD0,U,6):+$P(TIUD0,U,6),+TIUD21:+TIUD21,1:0)
|
|---|
| 42 | Q:+DADA'>0
|
|---|
| 43 | Q:+$D(@TIUY@("INDX",DADA))
|
|---|
| 44 | Q:+$D(^TIU(8925,DADA,0))=0
|
|---|
| 45 | D RESOLVE(TIUY,DADA,.QRY,.PATIENT)
|
|---|
| 46 | S @TIUY@("INDX",DADA)=""
|
|---|
| 47 | I +$G(SHOWADD) D SETKIDS(TIUY,DADA,.QRY,.PATIENT)
|
|---|
| 48 | I +$$HASDAD^TIUSRVLI(DADA) D SETDAD(TIUY,DADA,.QRY,.PATIENT)
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | SETKIDS(TIUY,DA,QRY,PATIENT) ; Set children in return array
|
|---|
| 52 | N KIDA S KIDA=0
|
|---|
| 53 | ; Begin with addenda
|
|---|
| 54 | F S KIDA=$O(^TIU(8925,"DAD",DA,KIDA)) Q:+KIDA'>0 D
|
|---|
| 55 | . Q:'+$$ISDOC(KIDA)
|
|---|
| 56 | . Q:+$D(@TIUY@("INDX",KIDA))
|
|---|
| 57 | . D RESOLVE(TIUY,KIDA,.QRY,.PATIENT)
|
|---|
| 58 | . S @TIUY@("INDX",KIDA)=""
|
|---|
| 59 | ; Next do ID entries
|
|---|
| 60 | S KIDA=0
|
|---|
| 61 | F S KIDA=$O(^TIU(8925,"GDAD",DA,KIDA)) Q:+KIDA'>0 D
|
|---|
| 62 | . Q:+$D(@TIUY@("INDX",KIDA))
|
|---|
| 63 | . D RESOLVE(TIUY,KIDA,.QRY,.PATIENT)
|
|---|
| 64 | . S @TIUY@("INDX",KIDA)=""
|
|---|
| 65 | . I +$$HASKIDS^TIUSRVLI(KIDA) D SETKIDS(TIUY,KIDA,.QRY,.PATIENT)
|
|---|
| 66 | Q
|
|---|
| 67 | ISDOC(DA) ; Evaluate whether a given record is a document
|
|---|
| 68 | N TIUY,TIUTYP
|
|---|
| 69 | S TIUTYP=+$G(^TIU(8925,DA,0))
|
|---|
| 70 | S TIUY=$S($P($G(^TIU(8925.1,+TIUTYP,0)),U,4)="DOC":1,1:0)
|
|---|
| 71 | Q TIUY
|
|---|
