- GMTSULT4 ; SLC/KER - HS Type Lookup (Array) ; 08/27/2002
- ;;2.7;Health Summary;**30,32,56**;Oct 20, 1995
- ;
- ; External References
- ; DBIA 10060 ^VA(200,
- ; DBIA 2056 $$GET1^DIQ (file #200)
- ; DBIA 10040 ^SC( file #44
- ;
- Q
- NT ; In Name/Title Array
- Q:$D(GMTSINPT) Q:+GMTSWDS'>0 K GMTSLT D CMN
- S GMTSFND=0,GMTSLT("W")=+($G(GMTSWDS))
- N GMTSNT F GMTSI=1:1:GMTSWDS D
- . Q:'$L(GMTSWRDS(GMTSI))
- . S GMTSNT=+($$CHKW(GMTSWRDS(GMTSI)))
- . S:GMTSNT GMTSFND=GMTSFND+1,GMTSLT(GMTSI1)=(+($G(GMTSLT(GMTSI1)))+1)
- I GMTSFND>0,GMTSFND=GMTSWDS,'$D(GMTSLT(GMTSI1)) S GMTSLT(0)=+($G(GMTSLT(0)))+1
- ; Reorder
- S GMTSFND=0 F S GMTSFND=$O(GMTSLT(GMTSFND)) Q:+GMTSFND=0 D
- . S:+($G(GMTSLT(GMTSFND)))>0&(+($G(GMTSLT(GMTSFND)))=+($G(GMTSLT("W")))) GMTSLT("B",+GMTSFND)=""
- . K:+($G(GMTSLT(GMTSFND)))>0&(+($G(GMTSLT(GMTSFND)))'=+($G(GMTSLT("W")))) GMTSLT(+GMTSFND)
- K GMTSLT("W") K:'$D(GMTSLT("B")) GMTSLT
- S:$D(GMTSLT("B")) GMTSLT("C")=$$MX($P($G(^GMT(142,+($G(GMTSIEN)),0)),"^",1))
- Q
- LC ; Location Array (Needs either GMTSIEN or GMTSI1)
- Q:$D(GMTSINPT) Q:+GMTSWDS'>0
- I '$D(GMTSI1),$D(GMTSIEN),$D(^GMT(142,+($G(GMTSIEN)),0)) N GMTSI1 S GMTSI1=+($G(GMTSIEN))
- Q:'$D(GMTSI1)
- N GMTSF,GMTSI,GMTSI2,GMTSI3,GMTSL,GMTSLC K GMTSLI
- S GMTSI2=0 F S GMTSI2=$O(^GMT(142,GMTSI1,20,GMTSI2)) Q:+GMTSI2=0 D
- . S GMTSI3=+($G(^GMT(142,GMTSI1,20,GMTSI2,0)))
- . S GMTSL=$P($G(^SC(+GMTSI3,0)),"^",1)
- . S GMTSF=0 I GMTSWDS>0 S GMTSLI("W")=+($G(GMTSWDS))
- . F GMTSI=1:1:GMTSWDS D
- . . Q:'$L(GMTSWRDS(GMTSI))
- . . S:$$UP(GMTSL)[$$UP(GMTSWRDS(GMTSI)) GMTSF=GMTSF+1
- . I GMTSF=GMTSWDS D
- . . S:'$D(GMTSLI(GMTSI1,GMTSI2)) GMTSLI(0)=+($G(GMTSLI(0)))+1
- . . S GMTSLI(GMTSI2)=GMTSF_"^"_GMTSL
- . . S GMTSLI("I")=GMTSI1
- S GMTSF=0 F S GMTSF=$O(GMTSLI(GMTSF)) Q:+GMTSF=0 D
- . S:+($G(GMTSLI(GMTSF)))>0&(+($G(GMTSLI(GMTSF)))=+($G(GMTSLI("W")))) GMTSLI("B",+GMTSF)=""
- . K:+($G(GMTSLI(GMTSF)))>0&(+($G(GMTSLI(GMTSF)))'=+($G(GMTSLI("W")))) GMTSLI(+GMTSF)
- K:'$D(GMTSLI("B")) GMTSLI
- I $D(GMTSLI("B")) D
- . N GMTSI,GMTSC,GMTST,GMTSE S (GMTSE,GMTSC)=0,GMTST=+($G(GMTSLI(0))) Q:GMTST=0
- . S GMTSI="",GMTSF=0 F S GMTSF=$O(GMTSLI(GMTSF)) Q:GMTSE Q:+GMTSF=0 D Q:GMTSE
- . . I ($L($G(GMTSI))+$L($P($G(GMTSLI(GMTSF)),"^",2)))>60 S GMTSI="",GMTSE=1 Q
- . . S GMTSC=GMTSC+1
- . . S:GMTSI'=""&(GMTSC>1)&(GMTSC'=GMTST) GMTSI=GMTSI_", "_$$MX($P(GMTSLI(GMTSF),"^",2))
- . . S:GMTSI'=""&(GMTSC>1)&(GMTSC=GMTST) GMTSI=GMTSI_" and "_$$MX($P(GMTSLI(GMTSF),"^",2))
- . . S:GMTSI="" GMTSI=$$MX($P(GMTSLI(GMTSF),"^",2))
- . S:$L(GMTSI) GMTSLI("C")=GMTSI
- K:'$D(GMTSLI("C")) GMTSLI K GMTSLI("W")
- Q
- CHKW(X) ; Check Words
- S X=$$UP($G(X)) Q:'$L(X) 0
- N I,OK S OK=0,I=0 F S I=$O(GMTSCOMP(I)) Q:+I=0 S:$$UP($G(GMTSCOMP(I)))[X OK=1 Q:OK
- S X=+($G(OK)) Q X
- ;
- CM ; Composite Array
- K GMTSCOMP S GMTSIEN=+($G(GMTSIEN)) G:GMTSIEN=0 CMQ
- N GMTSWL,GMTSL,GMTS2
- D:$D(GMTSNAM) CMP($$UP($$UP(GMTSNAM))) D:'$D(GMTSNAM) CMP($$UP($P($G(^GMT(142,+GMTSIEN,0)),"^",1)))
- D:$D(GMTSTTL) CMP($$UP($G(GMTSTTL))) D:'$D(GMTSTTL) CMP($$UP($P($G(^GMT(142,+GMTSIEN,"T")),"^",1)))
- D:$D(GMTSOW) CMP($$UP($G(GMTSOW)))
- I '$D(GMTSOW),+($P($G(^GMT(142,+GMTSIEN,0)),"^",3))>1 D CMP($$UP($$GET1^DIQ(200,(+($P($G(^GMT(142,+GMTSIEN,0)),"^",3))_","),.01)))
- G:$D(GMTSNO) CMQ
- S GMTS2=0 F S GMTS2=$O(^GMT(142,GMTSIEN,20,GMTS2)) Q:+GMTS2=0 D
- . S GMTSL=+($G(^GMT(142,GMTSIEN,20,GMTS2,0)))
- . S GMTSL=$P($G(^SC(+GMTSL,0)),"^",1) D CMP($$UP(GMTSL))
- CMQ ; Composite Array Quit
- D CMC Q
- CMA ; Composite Array (name only)
- N GMTSNO D CM Q
- CMN ; Composite Array (name only)
- N GMTSNO S GMTSNO="" D CM Q
- CMP(X) ; Composite Array Word Parse
- N GMTSX,GMTSP,GMTSC,GMTSW S GMTSX=$G(X) Q:'$L(GMTSX)
- S GMTSC=1 F GMTSP=1:1:$L(GMTSX)+1 D
- . S GMTSW=$E(GMTSX,GMTSP) I "(,.?! '-/&:;)"[GMTSW D
- . . S GMTSW=$E($E(GMTSX,GMTSC,GMTSP-1),1,30),GMTSC=GMTSP+1 I $L(GMTSW)>0 D
- . . . S:$L(GMTSW) GMTSWL(GMTSW)=""
- Q
- CMC ; Composite Array Compile
- S GMTSCOMP("B")="" N GMTSW,GMTSLI S GMTSW=""
- F S GMTSW=$O(GMTSWL(GMTSW)) Q:GMTSW="" D
- . I $L(GMTSCOMP("B")_" "_GMTSW)>200 D CMCA S GMTSCOMP("B")=GMTSCOMP("B")_" "_$$UP(GMTSW) K GMTSWL(GMTSW) Q
- . S GMTSCOMP("B")=GMTSCOMP("B")_" "_$$UP(GMTSW) K GMTSWL(GMTSW) Q
- F Q:$E(GMTSCOMP("B"),1)'=" " S GMTSCOMP("B")=$E(GMTSCOMP("B"),2,$L(GMTSCOMP("B")))
- S GMTSLI=+($O(GMTSCOMP(" "),-1)) I $D(GMTSCOMP("B")) S GMTSCOMP((GMTSLI+1))=GMTSCOMP("B") K GMTSCOMP("B")
- Q
- CMCA ; Composite Array Compile (Add String)
- N I S I=+($O(GMTSCOMP(" "),-1))+1 S GMTSCOMP(I)=GMTSCOMP("B"),GMTSCOMP("B")=""
- F Q:$E(GMTSCOMP(I),1)'=" " S GMTSCOMP(I)=$E(GMTSCOMP(I),2,$L(GMTSCOMP(I)))
- Q
- ;
- RDT ; Recommended Display Text
- ; Name (used by Location)
- I GMTSKEY["LOC" D
- . Q:'$L(GMTS5)
- . S:$$UP(GMTS2)'=$$UP(GMTS5) GMTSG=GMTSMN_" (used by "_GMTSLOC
- . S:$$UP(GMTSMN)=$$UP(GMTSLOC) GMTSG=GMTSMN
- ; Name (Title)
- I GMTSKEY["TITL",GMTSKEY'["OWN" D
- . Q:'$L(GMTS3)
- . I $$UP(GMTS3)=$$UP(GMTS2) S GMTSG=GMTS2 Q
- . S:GMTSKEY["TITL"&($$UP(GMTSMN)'=$$UP(GMTSL)) GMTSG=GMTSMN_" ("_$$MX(GMTS3)_")"
- . S:GMTSKEY["TITL"&($$UP(GMTSMN)=$$UP(GMTSL)) GMTSG=GMTSMN
- I GMTSKEY["TITL",GMTSKEY["OWN" D
- . Q:'$L(GMTS3)
- . ; Name (Title, Owner) if Title'=Name and Owner
- . S:$$UP(GMTSMN)'=$$UP(GMTS3)&($L(GMTS4)) GMTSG=GMTSMN_" ("_$$MX(GMTS3)_", HS Owner "_$$OW(GMTSOW)
- . ; Name (Title) if Title'=Name and no Owner
- . S:$$UP(GMTSMN)'=$$UP(GMTS3)&('$L(GMTS4)) GMTSG=GMTSMN_" ("_$$MX(GMTSTTL)
- . ; Name (Owner) if Title=Name and Owner
- . S:$$UP(GMTSMN)=$$UP(GMTS3)&($L(GMTS4)) GMTSG=GMTSMN_" (HS Owner "_$$OW(GMTSOW)
- . S:$$UP(GMTSMN)=$$UP(GMTS3)&('$L(GMTS4)) GMTSG=GMTSMN
- ;
- ; Assemble string and store in TMP Global
- ; IEN^Name^Title^Owner^Location^Components^Display Text
- S:$L(GMTSG)&(GMTSG'[")")&(GMTSG'["(")&(+GMTS6=0)&($L(GMTS6)) GMTSG=GMTSG_" ("_GMTS6_")" S GMTS7=GMTSG
- S ^TMP("GMTSULT",$J,GMTSI)=GMTS1_U_GMTS2_U_GMTS3_U_GMTS4_U_GMTS5_U_GMTS6_U_GMTS7
- S ^TMP("GMTSULT",$J,0)=GMTSI
- Q
- ;
- ; Miscellaneous
- UP(X) ; Uppercase
- Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- OW(X) ; Mix Case (owner name)
- Q:$G(X)'["," $$EN^GMTSUMX($G(X))
- Q $$EN^GMTSUMX(($P($G(X),",",1)_", "_$P($G(X),",",2)))
- MX(X) ; Mix Case
- Q $$EN^GMTSUMX(X)
- GMTSULT4 ; SLC/KER - HS Type Lookup (Array) ; 08/27/2002
- +1 ;;2.7;Health Summary;**30,32,56**;Oct 20, 1995
- +2 ;
- +3 ; External References
- +4 ; DBIA 10060 ^VA(200,
- +5 ; DBIA 2056 $$GET1^DIQ (file #200)
- +6 ; DBIA 10040 ^SC( file #44
- +7 ;
- +8 QUIT
- NT ; In Name/Title Array
- +1 IF $DATA(GMTSINPT)
- QUIT
- IF +GMTSWDS'>0
- QUIT
- KILL GMTSLT
- DO CMN
- +2 SET GMTSFND=0
- SET GMTSLT("W")=+($GET(GMTSWDS))
- +3 NEW GMTSNT
- FOR GMTSI=1:1:GMTSWDS
- Begin DoDot:1
- +4 IF '$LENGTH(GMTSWRDS(GMTSI))
- QUIT
- +5 SET GMTSNT=+($$CHKW(GMTSWRDS(GMTSI)))
- +6 IF GMTSNT
- SET GMTSFND=GMTSFND+1
- SET GMTSLT(GMTSI1)=(+($GET(GMTSLT(GMTSI1)))+1)
- End DoDot:1
- +7 IF GMTSFND>0
- IF GMTSFND=GMTSWDS
- IF '$DATA(GMTSLT(GMTSI1))
- SET GMTSLT(0)=+($GET(GMTSLT(0)))+1
- +8 ; Reorder
- +9 SET GMTSFND=0
- FOR
- SET GMTSFND=$ORDER(GMTSLT(GMTSFND))
- IF +GMTSFND=0
- QUIT
- Begin DoDot:1
- +10 IF +($GET(GMTSLT(GMTSFND)))>0&(+($GET(GMTSLT(GMTSFND)))=+($GET(GMTSLT("W"))))
- SET GMTSLT("B",+GMTSFND)=""
- +11 IF +($GET(GMTSLT(GMTSFND)))>0&(+($GET(GMTSLT(GMTSFND)))'=+($GET(GMTSLT("W"))))
- KILL GMTSLT(+GMTSFND)
- End DoDot:1
- +12 KILL GMTSLT("W")
- IF '$DATA(GMTSLT("B"))
- KILL GMTSLT
- +13 IF $DATA(GMTSLT("B"))
- SET GMTSLT("C")=$$MX($PIECE($GET(^GMT(142,+($GET(GMTSIEN)),0)),"^",1))
- +14 QUIT
- LC ; Location Array (Needs either GMTSIEN or GMTSI1)
- +1 IF $DATA(GMTSINPT)
- QUIT
- IF +GMTSWDS'>0
- QUIT
- +2 IF '$DATA(GMTSI1)
- IF $DATA(GMTSIEN)
- IF $DATA(^GMT(142,+($GET(GMTSIEN)),0))
- NEW GMTSI1
- SET GMTSI1=+($GET(GMTSIEN))
- +3 IF '$DATA(GMTSI1)
- QUIT
- +4 NEW GMTSF,GMTSI,GMTSI2,GMTSI3,GMTSL,GMTSLC
- KILL GMTSLI
- +5 SET GMTSI2=0
- FOR
- SET GMTSI2=$ORDER(^GMT(142,GMTSI1,20,GMTSI2))
- IF +GMTSI2=0
- QUIT
- Begin DoDot:1
- +6 SET GMTSI3=+($GET(^GMT(142,GMTSI1,20,GMTSI2,0)))
- +7 SET GMTSL=$PIECE($GET(^SC(+GMTSI3,0)),"^",1)
- +8 SET GMTSF=0
- IF GMTSWDS>0
- SET GMTSLI("W")=+($GET(GMTSWDS))
- +9 FOR GMTSI=1:1:GMTSWDS
- Begin DoDot:2
- +10 IF '$LENGTH(GMTSWRDS(GMTSI))
- QUIT
- +11 IF $$UP(GMTSL)[$$UP(GMTSWRDS(GMTSI))
- SET GMTSF=GMTSF+1
- End DoDot:2
- +12 IF GMTSF=GMTSWDS
- Begin DoDot:2
- +13 IF '$DATA(GMTSLI(GMTSI1,GMTSI2))
- SET GMTSLI(0)=+($GET(GMTSLI(0)))+1
- +14 SET GMTSLI(GMTSI2)=GMTSF_"^"_GMTSL
- +15 SET GMTSLI("I")=GMTSI1
- End DoDot:2
- End DoDot:1
- +16 SET GMTSF=0
- FOR
- SET GMTSF=$ORDER(GMTSLI(GMTSF))
- IF +GMTSF=0
- QUIT
- Begin DoDot:1
- +17 IF +($GET(GMTSLI(GMTSF)))>0&(+($GET(GMTSLI(GMTSF)))=+($GET(GMTSLI("W"))))
- SET GMTSLI("B",+GMTSF)=""
- +18 IF +($GET(GMTSLI(GMTSF)))>0&(+($GET(GMTSLI(GMTSF)))'=+($GET(GMTSLI("W"))))
- KILL GMTSLI(+GMTSF)
- End DoDot:1
- +19 IF '$DATA(GMTSLI("B"))
- KILL GMTSLI
- +20 IF $DATA(GMTSLI("B"))
- Begin DoDot:1
- +21 NEW GMTSI,GMTSC,GMTST,GMTSE
- SET (GMTSE,GMTSC)=0
- SET GMTST=+($GET(GMTSLI(0)))
- IF GMTST=0
- QUIT
- +22 SET GMTSI=""
- SET GMTSF=0
- FOR
- SET GMTSF=$ORDER(GMTSLI(GMTSF))
- IF GMTSE
- QUIT
- IF +GMTSF=0
- QUIT
- Begin DoDot:2
- +23 IF ($LENGTH($GET(GMTSI))+$LENGTH($PIECE($GET(GMTSLI(GMTSF)),"^",2)))>60
- SET GMTSI=""
- SET GMTSE=1
- QUIT
- +24 SET GMTSC=GMTSC+1
- +25 IF GMTSI'=""&(GMTSC>1)&(GMTSC'=GMTST)
- SET GMTSI=GMTSI_", "_$$MX($PIECE(GMTSLI(GMTSF),"^",2))
- +26 IF GMTSI'=""&(GMTSC>1)&(GMTSC=GMTST)
- SET GMTSI=GMTSI_" and "_$$MX($PIECE(GMTSLI(GMTSF),"^",2))
- +27 IF GMTSI=""
- SET GMTSI=$$MX($PIECE(GMTSLI(GMTSF),"^",2))
- End DoDot:2
- IF GMTSE
- QUIT
- +28 IF $LENGTH(GMTSI)
- SET GMTSLI("C")=GMTSI
- End DoDot:1
- +29 IF '$DATA(GMTSLI("C"))
- KILL GMTSLI
- KILL GMTSLI("W")
- +30 QUIT
- CHKW(X) ; Check Words
- +1 SET X=$$UP($GET(X))
- IF '$LENGTH(X)
- QUIT 0
- +2 NEW I,OK
- SET OK=0
- SET I=0
- FOR
- SET I=$ORDER(GMTSCOMP(I))
- IF +I=0
- QUIT
- IF $$UP($GET(GMTSCOMP(I)))[X
- SET OK=1
- IF OK
- QUIT
- +3 SET X=+($GET(OK))
- QUIT X
- +4 ;
- CM ; Composite Array
- +1 KILL GMTSCOMP
- SET GMTSIEN=+($GET(GMTSIEN))
- IF GMTSIEN=0
- GOTO CMQ
- +2 NEW GMTSWL,GMTSL,GMTS2
- +3 IF $DATA(GMTSNAM)
- DO CMP($$UP($$UP(GMTSNAM)))
- IF '$DATA(GMTSNAM)
- DO CMP($$UP($PIECE($GET(^GMT(142,+GMTSIEN,0)),"^",1)))
- +4 IF $DATA(GMTSTTL)
- DO CMP($$UP($GET(GMTSTTL)))
- IF '$DATA(GMTSTTL)
- DO CMP($$UP($PIECE($GET(^GMT(142,+GMTSIEN,"T")),"^",1)))
- +5 IF $DATA(GMTSOW)
- DO CMP($$UP($GET(GMTSOW)))
- +6 IF '$DATA(GMTSOW)
- IF +($PIECE($GET(^GMT(142,+GMTSIEN,0)),"^",3))>1
- DO CMP($$UP($$GET1^DIQ(200,(+($PIECE($GET(^GMT(142,+GMTSIEN,0)),"^",3))_","),.01)))
- +7 IF $DATA(GMTSNO)
- GOTO CMQ
- +8 SET GMTS2=0
- FOR
- SET GMTS2=$ORDER(^GMT(142,GMTSIEN,20,GMTS2))
- IF +GMTS2=0
- QUIT
- Begin DoDot:1
- +9 SET GMTSL=+($GET(^GMT(142,GMTSIEN,20,GMTS2,0)))
- +10 SET GMTSL=$PIECE($GET(^SC(+GMTSL,0)),"^",1)
- DO CMP($$UP(GMTSL))
- End DoDot:1
- CMQ ; Composite Array Quit
- +1 DO CMC
- QUIT
- CMA ; Composite Array (name only)
- +1 NEW GMTSNO
- DO CM
- QUIT
- CMN ; Composite Array (name only)
- +1 NEW GMTSNO
- SET GMTSNO=""
- DO CM
- QUIT
- CMP(X) ; Composite Array Word Parse
- +1 NEW GMTSX,GMTSP,GMTSC,GMTSW
- SET GMTSX=$GET(X)
- IF '$LENGTH(GMTSX)
- QUIT
- +2 SET GMTSC=1
- FOR GMTSP=1:1:$LENGTH(GMTSX)+1
- Begin DoDot:1
- +3 SET GMTSW=$EXTRACT(GMTSX,GMTSP)
- IF "(,.?! '-/&:;)"[GMTSW
- Begin DoDot:2
- +4 SET GMTSW=$EXTRACT($EXTRACT(GMTSX,GMTSC,GMTSP-1),1,30)
- SET GMTSC=GMTSP+1
- IF $LENGTH(GMTSW)>0
- Begin DoDot:3
- +5 IF $LENGTH(GMTSW)
- SET GMTSWL(GMTSW)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +6 QUIT
- CMC ; Composite Array Compile
- +1 SET GMTSCOMP("B")=""
- NEW GMTSW,GMTSLI
- SET GMTSW=""
- +2 FOR
- SET GMTSW=$ORDER(GMTSWL(GMTSW))
- IF GMTSW=""
- QUIT
- Begin DoDot:1
- +3 IF $LENGTH(GMTSCOMP("B")_" "_GMTSW)>200
- DO CMCA
- SET GMTSCOMP("B")=GMTSCOMP("B")_" "_$$UP(GMTSW)
- KILL GMTSWL(GMTSW)
- QUIT
- +4 SET GMTSCOMP("B")=GMTSCOMP("B")_" "_$$UP(GMTSW)
- KILL GMTSWL(GMTSW)
- QUIT
- End DoDot:1
- +5 FOR
- IF $EXTRACT(GMTSCOMP("B"),1)'=" "
- QUIT
- SET GMTSCOMP("B")=$EXTRACT(GMTSCOMP("B"),2,$LENGTH(GMTSCOMP("B")))
- +6 SET GMTSLI=+($ORDER(GMTSCOMP(" "),-1))
- IF $DATA(GMTSCOMP("B"))
- SET GMTSCOMP((GMTSLI+1))=GMTSCOMP("B")
- KILL GMTSCOMP("B")
- +7 QUIT
- CMCA ; Composite Array Compile (Add String)
- +1 NEW I
- SET I=+($ORDER(GMTSCOMP(" "),-1))+1
- SET GMTSCOMP(I)=GMTSCOMP("B")
- SET GMTSCOMP("B")=""
- +2 FOR
- IF $EXTRACT(GMTSCOMP(I),1)'=" "
- QUIT
- SET GMTSCOMP(I)=$EXTRACT(GMTSCOMP(I),2,$LENGTH(GMTSCOMP(I)))
- +3 QUIT
- +4 ;
- RDT ; Recommended Display Text
- +1 ; Name (used by Location)
- +2 IF GMTSKEY["LOC"
- Begin DoDot:1
- +3 IF '$LENGTH(GMTS5)
- QUIT
- +4 IF $$UP(GMTS2)'=$$UP(GMTS5)
- SET GMTSG=GMTSMN_" (used by "_GMTSLOC
- +5 IF $$UP(GMTSMN)=$$UP(GMTSLOC)
- SET GMTSG=GMTSMN
- End DoDot:1
- +6 ; Name (Title)
- +7 IF GMTSKEY["TITL"
- IF GMTSKEY'["OWN"
- Begin DoDot:1
- +8 IF '$LENGTH(GMTS3)
- QUIT
- +9 IF $$UP(GMTS3)=$$UP(GMTS2)
- SET GMTSG=GMTS2
- QUIT
- +10 IF GMTSKEY["TITL"&($$UP(GMTSMN)'=$$UP(GMTSL))
- SET GMTSG=GMTSMN_" ("_$$MX(GMTS3)_")"
- +11 IF GMTSKEY["TITL"&($$UP(GMTSMN)=$$UP(GMTSL))
- SET GMTSG=GMTSMN
- End DoDot:1
- +12 IF GMTSKEY["TITL"
- IF GMTSKEY["OWN"
- Begin DoDot:1
- +13 IF '$LENGTH(GMTS3)
- QUIT
- +14 ; Name (Title, Owner) if Title'=Name and Owner
- +15 IF $$UP(GMTSMN)'=$$UP(GMTS3)&($LENGTH(GMTS4))
- SET GMTSG=GMTSMN_" ("_$$MX(GMTS3)_", HS Owner "_$$OW(GMTSOW)
- +16 ; Name (Title) if Title'=Name and no Owner
- +17 IF $$UP(GMTSMN)'=$$UP(GMTS3)&('$LENGTH(GMTS4))
- SET GMTSG=GMTSMN_" ("_$$MX(GMTSTTL)
- +18 ; Name (Owner) if Title=Name and Owner
- +19 IF $$UP(GMTSMN)=$$UP(GMTS3)&($LENGTH(GMTS4))
- SET GMTSG=GMTSMN_" (HS Owner "_$$OW(GMTSOW)
- +20 IF $$UP(GMTSMN)=$$UP(GMTS3)&('$LENGTH(GMTS4))
- SET GMTSG=GMTSMN
- End DoDot:1
- +21 ;
- +22 ; Assemble string and store in TMP Global
- +23 ; IEN^Name^Title^Owner^Location^Components^Display Text
- +24 IF $LENGTH(GMTSG)&(GMTSG'[")")&(GMTSG'["(")&(+GMTS6=0)&($LENGTH(GMTS6))
- SET GMTSG=GMTSG_" ("_GMTS6_")"
- SET GMTS7=GMTSG
- +25 SET ^TMP("GMTSULT",$JOB,GMTSI)=GMTS1_U_GMTS2_U_GMTS3_U_GMTS4_U_GMTS5_U_GMTS6_U_GMTS7
- +26 SET ^TMP("GMTSULT",$JOB,0)=GMTSI
- +27 QUIT
- +28 ;
- +29 ; Miscellaneous
- UP(X) ; Uppercase
- +1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- OW(X) ; Mix Case (owner name)
- +1 IF $GET(X)'[","
- QUIT $$EN^GMTSUMX($GET(X))
- +2 QUIT $$EN^GMTSUMX(($PIECE($GET(X),",",1)_", "_$PIECE($GET(X),",",2)))
- MX(X) ; Mix Case
- +1 QUIT $$EN^GMTSUMX(X)
