GMTSULT3 ; SLC/KER - HS Type Lookup (Save) ; 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)
;
Q
SM ; Save match
;
; GMTSIEN Type Internal Entry Number
; GMTSKWRD Keyword from AW index
; GMTSWRDS Parsed word array
; GMTSEO Exact Match (One) OE
; GMTSEQ Exact Match Required X
; GMTSIF Interal Entry Number N
;
S GMTSIEN=+($G(GMTSIEN)),GMTSKWRD=$G(GMTSKWRD),GMTSEO=+($G(GMTSEO)),GMTSEQ=+($G(GMTSEQ)),GMTSIF=+($G(GMTSIF)),U="^"
N GMTSCOMP,GMTSCF,GMTSWRD,GMTSWDS,GMTSEQ,GMTSLOK,GMTSOK,GMTSLT,GMTSLI,GMTSASM,GMTSI1,GMTSI2,GMTSI3,GMTSNAM,GMTSTTL,GMTSOW,GMTSLOC,GMTSCMP,GMTSRC
S (GMTSNAM,GMTSTTL,GMTSOW,GMTSLOC,GMTSCMP,GMTSRC)="",GMTSLOK=0,GMTSRC="Name",GMTSWRD=$G(GMTSWRDS(1)),GMTSWDS=+($O(GMTSWRDS(" "),-1))
; Get Internal Entry Number (IEN)
S GMTSI1=+($G(GMTSIEN)) Q:'$D(^GMT(142,GMTSI1,0))
; Check Screen - DIC("S")
S GMTSOK=1 I $L($G(GMTSDICS)) S GMTSOK=$$DICS^GMTSULT2(GMTSDICS,X,GMTSI1) Q:'GMTSOK
; Get Health Summary Type
; Components
S GMTSCMP=$$CM^GMTSULT2(+GMTSI1)
; Name
S GMTSNAM=$P($G(^GMT(142,+GMTSI1,0)),U,1)
; Title
S GMTSTTL=$P($G(^GMT(142,+GMTSI1,"T")),U,1)
S:$L(GMTSTTL) GMTSRC="Title"
; Owner
S GMTSOW=+($P($G(^GMT(142,+GMTSI1,0)),U,3)) S:GMTSOW<1 GMTSOW=""
S:+GMTSOW>0 GMTSOW=$$GET1^DIQ(200,(+GMTSOW_","),.01)
I $L($G(GMTSKWRD)) S:$L(GMTSOW)&(GMTSOW[GMTSKWRD) GMTSRC="Title/Owner"
; Name/Title
D NT^GMTSULT4
; Location
D LC^GMTSULT4
S:'$L($G(GMTSLT("C")))&($L($G(GMTSLI("C")))) GMTSLOC=$G(GMTSLI("C"))
; Get Composite String
D CMA^GMTSULT4
; Find words in string
S (GMTSCF,GMTSFND)=0 I GMTSWDS>0 F GMTSI=1:1:GMTSWDS D
. Q:'$L(GMTSWRDS(GMTSI))
. S GMTSCF=+($$CHKW^GMTSULT4(GMTSWRDS(GMTSI)))
. S:GMTSCF GMTSFND=GMTSFND+1
. S:$L(GMTSOW)&(GMTSOW[$$UP^GMTSULT2(GMTSWRDS(GMTSI))) GMTSRC="Title/Owner"
;
; If input is not an Internal Entry Number +GMTSIF=0
; and not all of the words were found GMTSFND'=GMTSWDS
; then quit
;
Q:'(+($G(GMTSIF)))&(GMTSFND'=GMTSWDS)
;
; Save Health Summary Type
; Exact match only DIC(0)["O" & DIC(0)["E"
I '(+($G(GMTSIF))),+($G(GMTSEO)),($$UP^GMTSULT2(GMTSNAM)'=$$UP^GMTSULT2(X)&($$UP^GMTSULT2(GMTSLOC)'=$$UP^GMTSULT2(X))) Q
S:$L(GMTSLOC) GMTSRC="Location"
; Quit if Health Summary is already saved
Q:$D(^TMP("GMTSULT2",$J,"IEN",+GMTSI1))&(+($G(^TMP("GMTSULT2",$J,"EM")))'=+GMTSI1)
;
; Assemble string and store in TMP Global
; IEN^Name^Title^Owner^Location^Components^Source
S GMTSC=+($O(^TMP("GMTSULT2",$J," "),-1))+1
S GMTSASM=GMTSI1_U_GMTSNAM_U_GMTSTTL_U_GMTSOW_U_GMTSLOC_U_GMTSCMP_U_GMTSRC
S ^TMP("GMTSULT2",$J,"IEN",+GMTSI1)="",^TMP("GMTSULT2",$J,GMTSC)=GMTSASM,^TMP("GMTSULT2",$J,"B",(GMTSNAM_" "),GMTSC)=""
S:+($G(^TMP("GMTSULT2",$J,"EM")))=GMTSI1 ^TMP("GMTSULT2",$J,"EMI")=GMTSC,^TMP("GMTSULT2",$J,"EMB")=GMTSNAM_" "
Q
;
REO ; Reorder List
S GMTSEO=+($G(GMTSEO)),GMTSEQ=+($G(GMTSEQ)),GMTSIF=+($G(GMTSIF))
N GMTSC,GMTSFND,GMTSG,GMTSI,GMTSIEN,GMTSKEY,GMTSL,GMTSCMP,GMTSOW,GMTSTTL,GMTSLOC,GMTSMN,GMTSNM
S GMTSI=0,GMTSFND=""
; Add exact match to the top of the selection list
I '$D(^TMP("GMTSULT2",$J,"E")),+($G(GMTSEO)) K ^TMP("GMTSULT2",$J)
I $D(^TMP("GMTSULT2",$J,"E")) D
. S GMTSI=0,GMTSC="E" D ADD
. S ^TMP("GMTSULT",$J,0)=GMTSI
. K ^TMP("GMTSULT2",$J,"E")
. ; Kill global (quit) if Exact Match is found
. ; and DIR(0) either contains OE or X
. K:+($G(GMTSEQ)) ^TMP("GMTSULT2",$J) K:+($G(GMTSEO)) ^TMP("GMTSULT2",$J)
; Kill global (quit) if Exact Match is not
; found and DIR(0)["OE"
I '$D(^TMP("GMTSULT2",$J,"E")),+($G(GMTSEO)) K ^TMP("GMTSULT2",$J)
; Add remaining entries in Alphabetical Order
F S GMTSFND=$O(^TMP("GMTSULT2",$J,"B",GMTSFND)) Q:GMTSFND="" D
. S GMTSC=0 F S GMTSC=$O(^TMP("GMTSULT2",$J,"B",GMTSFND,GMTSC)) Q:+GMTSC=0 D
. . D ADD
D CLEAN^GMTSULT
Q
;
ADD ; Add to list in appropriate order
N GMTS0,GMTS1,GMTS2,GMTS3,GMTS4,GMTS5,GMTS6,GMTS7
S GMTSI=+($G(GMTSI))+1,GMTS0=$G(^TMP("GMTSULT2",$J,GMTSC))
;
; Piece Data Element
;
; 1 Internal Entry Number
S (GMTS1,GMTSIEN)=+($P(GMTS0,U,1))
; 2 Health Summary Name
S (GMTSG,GMTSMN,GMTS2)=$$MX^GMTSULT2($P(GMTS0,U,2))
S GMTSNM=$$UP^GMTSULT2(GMTSMN)
; 3 Health Summary Title
S (GMTS3,GMTSTTL)=$$MX^GMTSULT2($P(GMTS0,U,3)),GMTSTTL=GMTSTTL_")"
; 4 Health Summary Owner
S (GMTS4,GMTSOW)=$$MX^GMTSULT2($P(GMTS0,U,4)),GMTSOW=GMTSOW_")"
; 5 Health Summary Location
S (GMTS5,GMTSLOC)=$$MX^GMTSULT2($P(GMTS0,U,5)),GMTSLOC=GMTSLOC_")"
; 6 Health Summary Components
S (GMTS6,GMTSCMP)=$P(GMTS0,U,6)
S GMTSL=$P(GMTS0,U,4)
; 7 Recommended Display Text
S GMTSKEY=$$UP^GMTSULT2($P(GMTS0,U,7))
;
; Recommended Display Text
D RDT^GMTSULT4
;
; 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSULT3 5521 printed Dec 13, 2024@02:00:30 Page 2
GMTSULT3 ; SLC/KER - HS Type Lookup (Save) ; 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 ;
+7 QUIT
SM ; Save match
+1 ;
+2 ; GMTSIEN Type Internal Entry Number
+3 ; GMTSKWRD Keyword from AW index
+4 ; GMTSWRDS Parsed word array
+5 ; GMTSEO Exact Match (One) OE
+6 ; GMTSEQ Exact Match Required X
+7 ; GMTSIF Interal Entry Number N
+8 ;
+9 SET GMTSIEN=+($GET(GMTSIEN))
SET GMTSKWRD=$GET(GMTSKWRD)
SET GMTSEO=+($GET(GMTSEO))
SET GMTSEQ=+($GET(GMTSEQ))
SET GMTSIF=+($GET(GMTSIF))
SET U="^"
+10 NEW GMTSCOMP,GMTSCF,GMTSWRD,GMTSWDS,GMTSEQ,GMTSLOK,GMTSOK,GMTSLT,GMTSLI,GMTSASM,GMTSI1,GMTSI2,GMTSI3,GMTSNAM,GMTSTTL,GMTSOW,GMTSLOC,GMTSCMP,GMTSRC
+11 SET (GMTSNAM,GMTSTTL,GMTSOW,GMTSLOC,GMTSCMP,GMTSRC)=""
SET GMTSLOK=0
SET GMTSRC="Name"
SET GMTSWRD=$GET(GMTSWRDS(1))
SET GMTSWDS=+($ORDER(GMTSWRDS(" "),-1))
+12 ; Get Internal Entry Number (IEN)
+13 SET GMTSI1=+($GET(GMTSIEN))
if '$DATA(^GMT(142,GMTSI1,0))
QUIT
+14 ; Check Screen - DIC("S")
+15 SET GMTSOK=1
IF $LENGTH($GET(GMTSDICS))
SET GMTSOK=$$DICS^GMTSULT2(GMTSDICS,X,GMTSI1)
if 'GMTSOK
QUIT
+16 ; Get Health Summary Type
+17 ; Components
+18 SET GMTSCMP=$$CM^GMTSULT2(+GMTSI1)
+19 ; Name
+20 SET GMTSNAM=$PIECE($GET(^GMT(142,+GMTSI1,0)),U,1)
+21 ; Title
+22 SET GMTSTTL=$PIECE($GET(^GMT(142,+GMTSI1,"T")),U,1)
+23 if $LENGTH(GMTSTTL)
SET GMTSRC="Title"
+24 ; Owner
+25 SET GMTSOW=+($PIECE($GET(^GMT(142,+GMTSI1,0)),U,3))
if GMTSOW<1
SET GMTSOW=""
+26 if +GMTSOW>0
SET GMTSOW=$$GET1^DIQ(200,(+GMTSOW_","),.01)
+27 IF $LENGTH($GET(GMTSKWRD))
if $LENGTH(GMTSOW)&(GMTSOW[GMTSKWRD)
SET GMTSRC="Title/Owner"
+28 ; Name/Title
+29 DO NT^GMTSULT4
+30 ; Location
+31 DO LC^GMTSULT4
+32 if '$LENGTH($GET(GMTSLT("C")))&($LENGTH($GET(GMTSLI("C"))))
SET GMTSLOC=$GET(GMTSLI("C"))
+33 ; Get Composite String
+34 DO CMA^GMTSULT4
+35 ; Find words in string
+36 SET (GMTSCF,GMTSFND)=0
IF GMTSWDS>0
FOR GMTSI=1:1:GMTSWDS
Begin DoDot:1
+37 if '$LENGTH(GMTSWRDS(GMTSI))
QUIT
+38 SET GMTSCF=+($$CHKW^GMTSULT4(GMTSWRDS(GMTSI)))
+39 if GMTSCF
SET GMTSFND=GMTSFND+1
+40 if $LENGTH(GMTSOW)&(GMTSOW[$$UP^GMTSULT2(GMTSWRDS(GMTSI)))
SET GMTSRC="Title/Owner"
End DoDot:1
+41 ;
+42 ; If input is not an Internal Entry Number +GMTSIF=0
+43 ; and not all of the words were found GMTSFND'=GMTSWDS
+44 ; then quit
+45 ;
+46 if '(+($GET(GMTSIF)))&(GMTSFND'=GMTSWDS)
QUIT
+47 ;
+48 ; Save Health Summary Type
+49 ; Exact match only DIC(0)["O" & DIC(0)["E"
+50 IF '(+($GET(GMTSIF)))
IF +($GET(GMTSEO))
IF ($$UP^GMTSULT2(GMTSNAM)'=$$UP^GMTSULT2(X)&($$UP^GMTSULT2(GMTSLOC)'=$$UP^GMTSULT2(X)))
QUIT
+51 if $LENGTH(GMTSLOC)
SET GMTSRC="Location"
+52 ; Quit if Health Summary is already saved
+53 if $DATA(^TMP("GMTSULT2",$JOB,"IEN",+GMTSI1))&(+($GET(^TMP("GMTSULT2",$JOB,"EM")))'=+GMTSI1)
QUIT
+54 ;
+55 ; Assemble string and store in TMP Global
+56 ; IEN^Name^Title^Owner^Location^Components^Source
+57 SET GMTSC=+($ORDER(^TMP("GMTSULT2",$JOB," "),-1))+1
+58 SET GMTSASM=GMTSI1_U_GMTSNAM_U_GMTSTTL_U_GMTSOW_U_GMTSLOC_U_GMTSCMP_U_GMTSRC
+59 SET ^TMP("GMTSULT2",$JOB,"IEN",+GMTSI1)=""
SET ^TMP("GMTSULT2",$JOB,GMTSC)=GMTSASM
SET ^TMP("GMTSULT2",$JOB,"B",(GMTSNAM_" "),GMTSC)=""
+60 if +($GET(^TMP("GMTSULT2",$JOB,"EM")))=GMTSI1
SET ^TMP("GMTSULT2",$JOB,"EMI")=GMTSC
SET ^TMP("GMTSULT2",$JOB,"EMB")=GMTSNAM_" "
+61 QUIT
+62 ;
REO ; Reorder List
+1 SET GMTSEO=+($GET(GMTSEO))
SET GMTSEQ=+($GET(GMTSEQ))
SET GMTSIF=+($GET(GMTSIF))
+2 NEW GMTSC,GMTSFND,GMTSG,GMTSI,GMTSIEN,GMTSKEY,GMTSL,GMTSCMP,GMTSOW,GMTSTTL,GMTSLOC,GMTSMN,GMTSNM
+3 SET GMTSI=0
SET GMTSFND=""
+4 ; Add exact match to the top of the selection list
+5 IF '$DATA(^TMP("GMTSULT2",$JOB,"E"))
IF +($GET(GMTSEO))
KILL ^TMP("GMTSULT2",$JOB)
+6 IF $DATA(^TMP("GMTSULT2",$JOB,"E"))
Begin DoDot:1
+7 SET GMTSI=0
SET GMTSC="E"
DO ADD
+8 SET ^TMP("GMTSULT",$JOB,0)=GMTSI
+9 KILL ^TMP("GMTSULT2",$JOB,"E")
+10 ; Kill global (quit) if Exact Match is found
+11 ; and DIR(0) either contains OE or X
+12 if +($GET(GMTSEQ))
KILL ^TMP("GMTSULT2",$JOB)
if +($GET(GMTSEO))
KILL ^TMP("GMTSULT2",$JOB)
End DoDot:1
+13 ; Kill global (quit) if Exact Match is not
+14 ; found and DIR(0)["OE"
+15 IF '$DATA(^TMP("GMTSULT2",$JOB,"E"))
IF +($GET(GMTSEO))
KILL ^TMP("GMTSULT2",$JOB)
+16 ; Add remaining entries in Alphabetical Order
+17 FOR
SET GMTSFND=$ORDER(^TMP("GMTSULT2",$JOB,"B",GMTSFND))
if GMTSFND=""
QUIT
Begin DoDot:1
+18 SET GMTSC=0
FOR
SET GMTSC=$ORDER(^TMP("GMTSULT2",$JOB,"B",GMTSFND,GMTSC))
if +GMTSC=0
QUIT
Begin DoDot:2
+19 DO ADD
End DoDot:2
End DoDot:1
+20 DO CLEAN^GMTSULT
+21 QUIT
+22 ;
ADD ; Add to list in appropriate order
+1 NEW GMTS0,GMTS1,GMTS2,GMTS3,GMTS4,GMTS5,GMTS6,GMTS7
+2 SET GMTSI=+($GET(GMTSI))+1
SET GMTS0=$GET(^TMP("GMTSULT2",$JOB,GMTSC))
+3 ;
+4 ; Piece Data Element
+5 ;
+6 ; 1 Internal Entry Number
+7 SET (GMTS1,GMTSIEN)=+($PIECE(GMTS0,U,1))
+8 ; 2 Health Summary Name
+9 SET (GMTSG,GMTSMN,GMTS2)=$$MX^GMTSULT2($PIECE(GMTS0,U,2))
+10 SET GMTSNM=$$UP^GMTSULT2(GMTSMN)
+11 ; 3 Health Summary Title
+12 SET (GMTS3,GMTSTTL)=$$MX^GMTSULT2($PIECE(GMTS0,U,3))
SET GMTSTTL=GMTSTTL_")"
+13 ; 4 Health Summary Owner
+14 SET (GMTS4,GMTSOW)=$$MX^GMTSULT2($PIECE(GMTS0,U,4))
SET GMTSOW=GMTSOW_")"
+15 ; 5 Health Summary Location
+16 SET (GMTS5,GMTSLOC)=$$MX^GMTSULT2($PIECE(GMTS0,U,5))
SET GMTSLOC=GMTSLOC_")"
+17 ; 6 Health Summary Components
+18 SET (GMTS6,GMTSCMP)=$PIECE(GMTS0,U,6)
+19 SET GMTSL=$PIECE(GMTS0,U,4)
+20 ; 7 Recommended Display Text
+21 SET GMTSKEY=$$UP^GMTSULT2($PIECE(GMTS0,U,7))
+22 ;
+23 ; Recommended Display Text
+24 DO RDT^GMTSULT4
+25 ;
+26 ; Assemble string and store in TMP Global
+27 ; IEN^Name^Title^Owner^Location^Components^Display Text
+28 if $LENGTH(GMTSG)&(GMTSG'[")")&(GMTSG'["(")&(+GMTS6=0)&($LENGTH(GMTS6))
SET GMTSG=GMTSG_" ("_GMTS6_")"
SET GMTS7=GMTSG
+29 SET ^TMP("GMTSULT",$JOB,GMTSI)=GMTS1_U_GMTS2_U_GMTS3_U_GMTS4_U_GMTS5_U_GMTS6_U_GMTS7
+30 SET ^TMP("GMTSULT",$JOB,0)=GMTSI
+31 QUIT
