source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSULT3.m@ 1666

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

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1GMTSULT3 ; SLC/KER - HS Type Lookup (Save) ; 08/27/2002
2 ;;2.7;Health Summary;**30,32,56**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 10060 ^VA(200,
6 ; DBIA 2056 $$GET1^DIQ (file #200)
7 ;
8 Q
9SM ; Save match
10 ;
11 ; GMTSIEN Type Internal Entry Number
12 ; GMTSKWRD Keyword from AW index
13 ; GMTSWRDS Parsed word array
14 ; GMTSEO Exact Match (One) OE
15 ; GMTSEQ Exact Match Required X
16 ; GMTSIF Interal Entry Number N
17 ;
18 S GMTSIEN=+($G(GMTSIEN)),GMTSKWRD=$G(GMTSKWRD),GMTSEO=+($G(GMTSEO)),GMTSEQ=+($G(GMTSEQ)),GMTSIF=+($G(GMTSIF)),U="^"
19 N GMTSCOMP,GMTSCF,GMTSWRD,GMTSWDS,GMTSEQ,GMTSLOK,GMTSOK,GMTSLT,GMTSLI,GMTSASM,GMTSI1,GMTSI2,GMTSI3,GMTSNAM,GMTSTTL,GMTSOW,GMTSLOC,GMTSCMP,GMTSRC
20 S (GMTSNAM,GMTSTTL,GMTSOW,GMTSLOC,GMTSCMP,GMTSRC)="",GMTSLOK=0,GMTSRC="Name",GMTSWRD=$G(GMTSWRDS(1)),GMTSWDS=+($O(GMTSWRDS(" "),-1))
21 ; Get Internal Entry Number (IEN)
22 S GMTSI1=+($G(GMTSIEN)) Q:'$D(^GMT(142,GMTSI1,0))
23 ; Check Screen - DIC("S")
24 S GMTSOK=1 I $L($G(GMTSDICS)) S GMTSOK=$$DICS^GMTSULT2(GMTSDICS,X,GMTSI1) Q:'GMTSOK
25 ; Get Health Summary Type
26 ; Components
27 S GMTSCMP=$$CM^GMTSULT2(+GMTSI1)
28 ; Name
29 S GMTSNAM=$P($G(^GMT(142,+GMTSI1,0)),U,1)
30 ; Title
31 S GMTSTTL=$P($G(^GMT(142,+GMTSI1,"T")),U,1)
32 S:$L(GMTSTTL) GMTSRC="Title"
33 ; Owner
34 S GMTSOW=+($P($G(^GMT(142,+GMTSI1,0)),U,3)) S:GMTSOW<1 GMTSOW=""
35 S:+GMTSOW>0 GMTSOW=$$GET1^DIQ(200,(+GMTSOW_","),.01)
36 I $L($G(GMTSKWRD)) S:$L(GMTSOW)&(GMTSOW[GMTSKWRD) GMTSRC="Title/Owner"
37 ; Name/Title
38 D NT^GMTSULT4
39 ; Location
40 D LC^GMTSULT4
41 S:'$L($G(GMTSLT("C")))&($L($G(GMTSLI("C")))) GMTSLOC=$G(GMTSLI("C"))
42 ; Get Composite String
43 D CMA^GMTSULT4
44 ; Find words in string
45 S (GMTSCF,GMTSFND)=0 I GMTSWDS>0 F GMTSI=1:1:GMTSWDS D
46 . Q:'$L(GMTSWRDS(GMTSI))
47 . S GMTSCF=+($$CHKW^GMTSULT4(GMTSWRDS(GMTSI)))
48 . S:GMTSCF GMTSFND=GMTSFND+1
49 . S:$L(GMTSOW)&(GMTSOW[$$UP^GMTSULT2(GMTSWRDS(GMTSI))) GMTSRC="Title/Owner"
50 ;
51 ; If input is not an Internal Entry Number +GMTSIF=0
52 ; and not all of the words were found GMTSFND'=GMTSWDS
53 ; then quit
54 ;
55 Q:'(+($G(GMTSIF)))&(GMTSFND'=GMTSWDS)
56 ;
57 ; Save Health Summary Type
58 ; Exact match only DIC(0)["O" & DIC(0)["E"
59 I '(+($G(GMTSIF))),+($G(GMTSEO)),($$UP^GMTSULT2(GMTSNAM)'=$$UP^GMTSULT2(X)&($$UP^GMTSULT2(GMTSLOC)'=$$UP^GMTSULT2(X))) Q
60 S:$L(GMTSLOC) GMTSRC="Location"
61 ; Quit if Health Summary is already saved
62 Q:$D(^TMP("GMTSULT2",$J,"IEN",+GMTSI1))&(+($G(^TMP("GMTSULT2",$J,"EM")))'=+GMTSI1)
63 ;
64 ; Assemble string and store in TMP Global
65 ; IEN^Name^Title^Owner^Location^Components^Source
66 S GMTSC=+($O(^TMP("GMTSULT2",$J," "),-1))+1
67 S GMTSASM=GMTSI1_U_GMTSNAM_U_GMTSTTL_U_GMTSOW_U_GMTSLOC_U_GMTSCMP_U_GMTSRC
68 S ^TMP("GMTSULT2",$J,"IEN",+GMTSI1)="",^TMP("GMTSULT2",$J,GMTSC)=GMTSASM,^TMP("GMTSULT2",$J,"B",(GMTSNAM_" "),GMTSC)=""
69 S:+($G(^TMP("GMTSULT2",$J,"EM")))=GMTSI1 ^TMP("GMTSULT2",$J,"EMI")=GMTSC,^TMP("GMTSULT2",$J,"EMB")=GMTSNAM_" "
70 Q
71 ;
72REO ; Reorder List
73 S GMTSEO=+($G(GMTSEO)),GMTSEQ=+($G(GMTSEQ)),GMTSIF=+($G(GMTSIF))
74 N GMTSC,GMTSFND,GMTSG,GMTSI,GMTSIEN,GMTSKEY,GMTSL,GMTSCMP,GMTSOW,GMTSTTL,GMTSLOC,GMTSMN,GMTSNM
75 S GMTSI=0,GMTSFND=""
76 ; Add exact match to the top of the selection list
77 I '$D(^TMP("GMTSULT2",$J,"E")),+($G(GMTSEO)) K ^TMP("GMTSULT2",$J)
78 I $D(^TMP("GMTSULT2",$J,"E")) D
79 . S GMTSI=0,GMTSC="E" D ADD
80 . S ^TMP("GMTSULT",$J,0)=GMTSI
81 . K ^TMP("GMTSULT2",$J,"E")
82 . ; Kill global (quit) if Exact Match is found
83 . ; and DIR(0) either contains OE or X
84 . K:+($G(GMTSEQ)) ^TMP("GMTSULT2",$J) K:+($G(GMTSEO)) ^TMP("GMTSULT2",$J)
85 ; Kill global (quit) if Exact Match is not
86 ; found and DIR(0)["OE"
87 I '$D(^TMP("GMTSULT2",$J,"E")),+($G(GMTSEO)) K ^TMP("GMTSULT2",$J)
88 ; Add remaining entries in Alphabetical Order
89 F S GMTSFND=$O(^TMP("GMTSULT2",$J,"B",GMTSFND)) Q:GMTSFND="" D
90 . S GMTSC=0 F S GMTSC=$O(^TMP("GMTSULT2",$J,"B",GMTSFND,GMTSC)) Q:+GMTSC=0 D
91 . . D ADD
92 D CLEAN^GMTSULT
93 Q
94 ;
95ADD ; Add to list in appropriate order
96 N GMTS0,GMTS1,GMTS2,GMTS3,GMTS4,GMTS5,GMTS6,GMTS7
97 S GMTSI=+($G(GMTSI))+1,GMTS0=$G(^TMP("GMTSULT2",$J,GMTSC))
98 ;
99 ; Piece Data Element
100 ;
101 ; 1 Internal Entry Number
102 S (GMTS1,GMTSIEN)=+($P(GMTS0,U,1))
103 ; 2 Health Summary Name
104 S (GMTSG,GMTSMN,GMTS2)=$$MX^GMTSULT2($P(GMTS0,U,2))
105 S GMTSNM=$$UP^GMTSULT2(GMTSMN)
106 ; 3 Health Summary Title
107 S (GMTS3,GMTSTTL)=$$MX^GMTSULT2($P(GMTS0,U,3)),GMTSTTL=GMTSTTL_")"
108 ; 4 Health Summary Owner
109 S (GMTS4,GMTSOW)=$$MX^GMTSULT2($P(GMTS0,U,4)),GMTSOW=GMTSOW_")"
110 ; 5 Health Summary Location
111 S (GMTS5,GMTSLOC)=$$MX^GMTSULT2($P(GMTS0,U,5)),GMTSLOC=GMTSLOC_")"
112 ; 6 Health Summary Components
113 S (GMTS6,GMTSCMP)=$P(GMTS0,U,6)
114 S GMTSL=$P(GMTS0,U,4)
115 ; 7 Recommended Display Text
116 S GMTSKEY=$$UP^GMTSULT2($P(GMTS0,U,7))
117 ;
118 ; Recommended Display Text
119 D RDT^GMTSULT4
120 ;
121 ; Assemble string and store in TMP Global
122 ; IEN^Name^Title^Owner^Location^Components^Display Text
123 S:$L(GMTSG)&(GMTSG'[")")&(GMTSG'["(")&(+GMTS6=0)&($L(GMTS6)) GMTSG=GMTSG_" ("_GMTS6_")" S GMTS7=GMTSG
124 S ^TMP("GMTSULT",$J,GMTSI)=GMTS1_U_GMTS2_U_GMTS3_U_GMTS4_U_GMTS5_U_GMTS6_U_GMTS7
125 S ^TMP("GMTSULT",$J,0)=GMTSI
126 Q
Note: See TracBrowser for help on using the repository browser.