source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUQRYL.m@ 1310

Last change on this file since 1310 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 2.9 KB
Line 
1TIUQRYL ; SLC/JER - Library calls for Query ;11-OCT-2002 16:56
2 ;;1.0;TEXT INTEGRATION UTILITIES;**150**;Jun 20, 1997
3RESOLVE(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 ;
36SETDAD(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 ;
51SETKIDS(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
67ISDOC(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
Note: See TracBrowser for help on using the repository browser.