GMTSULT2 ; SLC/KER - HS Type Lookup (Search/List) ; 08/27/2002
;;2.7;Health Summary;**30,32,35,29,56**;Oct 20, 1995
;
; External Reference
; DBIA 10016 ^DIM
;
Q
LIST(X) ; Get global array of Health Summary Types
;
; LIST^GMTSULT2(<search string>)
;
; ^TMP("GMTSULT",$J,#)
;
; Piece 1 = Internal Entry Number (IEN) in file 142
; Piece 2 = Health Summary Type Name
; Piece 3 = Health Summary Type Title
; Piece 4 = Health Summary Type Owner
; Piece 5 = Location Using Health Summary Type
; Piece 6 = Number of Components in Summary Type
; Piece 7 = Recommended Display Text (for
; selection or list box)
;
; List Builder can use variable DIC("S") and DIC(0)
;
; DIC("S") Screen out entries for selection/list
;
; Processes DIC(0) N, OE (combination),X or B
;
; Does not process DIC(0) components C or M. Cross
; reference suppression (C) is automatic in a multi-
; term lookup, and the use of multiple indexes is
; implied in the lookup and DD file structure.
;
D CLR^GMTSULT N GMTSEO,GMTSEQ,GMTSIF,GMTSBI,GMTSIEN,GMTSWRDS,GMTSDS,GMTSD0
S GMTSEO=+($$EMO),GMTSEQ=+($$EMQ),GMTSIF=+($$IF($G(X))),GMTSBI=+($$BI)
S:$L($G(DIC("S")))&('$L($G(GMTSDICS))) GMTSDICS=$G(DIC("S")),GMTSDS=1
S:$L($G(DIC(0)))&('$L($G(GMTSDIC0))) GMTSDIC0=$G(DIC(0)),GMTSD0=1
I GMTSIF S GMTSIEN=$$IENF(X) I +GMTSIEN>0 D IENS(GMTSIEN) G:$D(^TMP("GMTSULT",$J,1)) LQ
I GMTSBI D B^GMTSULT7 G LQ
D PAR,FND,REO^GMTSULT3
Q
LQ ; Quit List
K:+($G(GMTSDS))>0 GMTSDICS K:+($G(GMTSD0))>0 GMTSDIC0
Q
;
FND ; Find Health Summary Types (word search)
N GMTSB,GMTSC,GMTSCTL,GMTSFND,GMTSI,GMTSI1,GMTSI2,GMTSI3,GMTSDS,GMTSD0,GMTSLEX,GMTSLEXM,GMTSASM,GMTSCMP,GMTSLOC,GMTSNAM,GMTSOK,GMTSRC,GMTSOW,GMTSTMP,GMTSTTL,GMTSWDS,GMTSRD,GMTSWRD,Y
; Echo E or broker
S GMTSTMP=+($G(GMTSE)),GMTSIF=0 S:'$D(GMTSE) GMTSTMP=$$ECHO^GMTSULT N GMTSE S GMTSE=GMTSTMP,U="^"
; Exact Match X
S GMTSLEX=$$EM(X) D:$G(GMTSDIC0)["X"&(GMTSLEX'>0) CLR^GMTSULT G:$G(GMTSDIC0)["X"&(GMTSLEX'>0) FNDQ
S:+GMTSLEX>0 ^TMP("GMTSULT2",$J,"EM")=+GMTSLEX,^TMP("GMTSULT2",$J,"IEN",+GMTSLEX)=""
; One Exact Match OE
S GMTSLEXM=0 S:$G(GMTSDIC0)["O"&($G(GMTSDIC0)["E") GMTSLEXM=1
; Word Search
S GMTSWDS=$O(GMTSWRDS(" "),-1) S GMTSWRD=$G(GMTSWRDS(1))
G:'$L(GMTSWRD) FNDQ S GMTSCTL=GMTSWRD,GMTSWRD=$E(GMTSWRD,1,($L(GMTSWRD)-1))_$C($A($E(GMTSWRD,$L(GMTSWRD)))-1)_"~"
S:+GMTSCTL=GMTSCTL GMTSWRD=GMTSCTL-1
F S GMTSWRD=$O(^GMT(142,"AW",GMTSWRD)) Q:GMTSWRD=""!($E(GMTSWRD,1,$L(GMTSCTL))'=GMTSCTL) D
. S (GMTSC,GMTSI1)=0
. F S GMTSI1=$O(^GMT(142,"AW",GMTSWRD,GMTSI1)) Q:+GMTSI1=0 D
. . N GMTSIEN,GMTSKWRD S GMTSIEN=GMTSI1,GMTSKWRD=GMTSWRD
. . D SM^GMTSULT3
; Check for exact match in results
S GMTSI=+($G(^TMP("GMTSULT2",$J,"EMI")))
S GMTSB=$G(^TMP("GMTSULT2",$J,"EMB")) I GMTSI>0,$L(GMTSB)>0 D
. S ^TMP("GMTSULT2",$J,"E")=$G(^TMP("GMTSULT2",$J,GMTSI))
. K ^TMP("GMTSULT2",$J,GMTSI),^TMP("GMTSULT2",$J,"B",GMTSB),^TMP("GMTSULT2",$J,"EMB"),^TMP("GMTSULT2",$J,"EMI"),^TMP("GMTSULT2",$J,"EM")
FNDQ ; Find Quit
K:+($G(GMTSDS))>0 GMTSDICS K:+($G(GMTSD0))>0 GMTSDIC0
Q
;
PAR ; Parse User Input
K GMTSWRDS N GMTSC,GMTSCT,GMTSPSN,GMTSTR,GMTSWRD
S U="^",GMTSTR=$G(X) Q:'$L(GMTSTR) S GMTSC=1,GMTSCT=0 F GMTSPSN=1:1:$L(GMTSTR)+1 D
. S GMTSWRD=$E(GMTSTR,GMTSPSN) I "(,.?! '-/&:;)"[GMTSWRD D
. . S GMTSWRD=$TR($E($E(GMTSTR,GMTSC,GMTSPSN-1),1,30),"""",""),GMTSC=GMTSPSN+1
. . I $L(GMTSWRD)>0 S GMTSCT=GMTSCT+1,GMTSWRDS(GMTSCT)=$$UP(GMTSWRD)
Q
IENF(X) ; Internal Entry Number Find
N GMTS0,GMTSI S GMTSI=$G(X),X=$G(X),GMTS0=$G(DIC(0)) S:$E(X,1)="`" GMTSI=$E(GMTSI,2,$L(GMTSI)) S GMTSI=+GMTSI
I GMTS0["N",+GMTSI>0,$D(^GMT(142,+GMTSI,0)) S X=+GMTSI Q X
I $E(X,1)="`",+GMTSI>0,$D(^GMT(142,+GMTSI,0)) S X=+GMTSI Q X
Q -1
IENS(X) ; Internal Entry Number Save
N GMTSI1,GMTSI2,GMTSI3,GMTSIEN S (GMTSIEN,GMTSI1)=+X Q:+GMTSI1=0 Q:'$D(^GMT(142,+GMTSI1,0))
D SM^GMTSULT3,REO^GMTSULT3
Q
CM(X) ; Get Number of Components
S X=+($G(X)) Q:X=0 "No components" Q:'$D(^GMT(142,+X,1)) "No components"
N GMTSI,GMTSC S (GMTSC,GMTSI)=0 F S GMTSI=$O(^GMT(142,+X,1,GMTSI)) Q:+GMTSI=0 S GMTSC=GMTSC+1
S X=$S(+GMTSC>1:(+GMTSC_" components"),+GMTSC=1:(+GMTSC_" component"),1:"No components")
Q X
EM(X) ; Exact Match when DIC(0) contains X
S X=$G(X) Q:'$L(X) -1 N GMTSC,GMTSI,GMTSM,GMTSN,GMTSO,GMTSU S U="^"
S GMTSU=$$UP(X),(GMTSC,GMTSO)=$$UP($E(X,1,30)),GMTSM=0,GMTSO=$E(GMTSO,1,($L(GMTSO)-1))_$C($A($E(GMTSO,$L(GMTSO)))-1)_"~",GMTSM=0
F S GMTSO=$O(^GMT(142,"AB",GMTSO)) Q:GMTSO=""!(GMTSO'[GMTSC) D Q:+GMTSM>0
. S GMTSI=0 F S GMTSI=$O(^GMT(142,"AB",GMTSO,GMTSI)) Q:+GMTSI=0 D Q:+GMTSM>0
. . S GMTSN=$P($G(^GMT(142,+GMTSI,0)),U,1) S:$$UP(GMTSN)=GMTSU GMTSM=GMTSI_U_GMTSN
S:+GMTSM=0 GMTSM=-1 S X=GMTSM D Y^GMTSULT6(+GMTSM)
Q X
;
DICS(S,X,DA) ; Check DIC("S") Screen
N Y,GMTST,GMTSOX,GMTSDICS,GMTSIEN S (GMTSIEN,Y,DA)=+($G(DA)),GMTSDICS=$G(S),GMTSOX=$G(X) S X=GMTSDICS Q:'$L(GMTSDICS) 1
D ^DIM Q:'$L($G(X)) 1 S GMTST=$G(^GMT(142,+GMTSIEN,0)) Q:'$D(^GMT(142,+GMTSIEN,0)) 0 S X=GMTSOX,(Y,DA)=GMTSIEN Q:GMTSIEN'>0 0
X GMTSDICS S X=$T Q X
;
; Processing flags
EMQ(X) ; Exact match flag
N GMTS0 S X=0,GMTS0=$G(DIC(0)) Q:'$L(GMTS0) X
S:$G(GMTS0)["X" X=1 Q X
EMO(X) ; Exact match flag, only one
N GMTS0 S X=0 S GMTS0=$G(DIC(0)) Q:'$L(GMTS0) X
S:$G(GMTS0)["O"&($G(GMTS0)["E") X=1 Q X
BI(X) ; Use the B Index flag
N GMTS0 S X=0 S GMTS0=$G(DIC(0)) Q:'$L(GMTS0) X
S:$G(GMTS0)["B" X=1 Q X
IF(X) ; Internal Entry Number Flag
N GMTS0,GMTSI S GMTSI=0,GMTS0=$G(DIC(0)) Q:'$L($G(X)) 0
I $E(X,1)="`",$L($G(^GMT(142,+($E(X,2,$L(X))),0))) S GMTSI=1
I +X>0,$L($G(^GMT(142,+X,0))),GMTS0["N" S GMTSI=1
S X=GMTSI Q X
;
; TMP Global
TMP ; Show first ^TMP Global
N GMTSND,GMTSNC,GMTSNQ,GMTSC,GMTSTMP
S GMTSC=0,GMTSTMP="",GMTSNQ="^TMP(""GMTSULT2"","_$J_")",GMTSNC="^TMP(""GMTSULT2"","_$J_","
F S GMTSNQ=$Q(@GMTSNQ) Q:GMTSNQ=""!(GMTSNQ'[GMTSNC) D
. S GMTSC=GMTSC+1 W:GMTSC=1 ! S GMTSND=@GMTSNQ W !,GMTSNQ,"=",GMTSND
W:GMTSC>0 !
TMP2 ; Show second ^TMP Global
S GMTSC=0,GMTSNQ="^TMP(""GMTSULT"","_$J_")",GMTSNC="^TMP(""GMTSULT"","_$J_","
F S GMTSNQ=$Q(@GMTSNQ) Q:GMTSNQ=""!(GMTSNQ'[GMTSNC) D
. S GMTSC=GMTSC+1 W:'$D(GMTSTMP)&(GMTSC=1) ! S GMTSND=@GMTSNQ W !,GMTSNQ,"=",GMTSND
W:GMTSC>0 !
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)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSULT2 6983 printed Sep 23, 2025@19:36:34 Page 2
GMTSULT2 ; SLC/KER - HS Type Lookup (Search/List) ; 08/27/2002
+1 ;;2.7;Health Summary;**30,32,35,29,56**;Oct 20, 1995
+2 ;
+3 ; External Reference
+4 ; DBIA 10016 ^DIM
+5 ;
+6 QUIT
LIST(X) ; Get global array of Health Summary Types
+1 ;
+2 ; LIST^GMTSULT2(<search string>)
+3 ;
+4 ; ^TMP("GMTSULT",$J,#)
+5 ;
+6 ; Piece 1 = Internal Entry Number (IEN) in file 142
+7 ; Piece 2 = Health Summary Type Name
+8 ; Piece 3 = Health Summary Type Title
+9 ; Piece 4 = Health Summary Type Owner
+10 ; Piece 5 = Location Using Health Summary Type
+11 ; Piece 6 = Number of Components in Summary Type
+12 ; Piece 7 = Recommended Display Text (for
+13 ; selection or list box)
+14 ;
+15 ; List Builder can use variable DIC("S") and DIC(0)
+16 ;
+17 ; DIC("S") Screen out entries for selection/list
+18 ;
+19 ; Processes DIC(0) N, OE (combination),X or B
+20 ;
+21 ; Does not process DIC(0) components C or M. Cross
+22 ; reference suppression (C) is automatic in a multi-
+23 ; term lookup, and the use of multiple indexes is
+24 ; implied in the lookup and DD file structure.
+25 ;
+26 DO CLR^GMTSULT
NEW GMTSEO,GMTSEQ,GMTSIF,GMTSBI,GMTSIEN,GMTSWRDS,GMTSDS,GMTSD0
+27 SET GMTSEO=+($$EMO)
SET GMTSEQ=+($$EMQ)
SET GMTSIF=+($$IF($GET(X)))
SET GMTSBI=+($$BI)
+28 if $LENGTH($GET(DIC("S")))&('$LENGTH($GET(GMTSDICS)))
SET GMTSDICS=$GET(DIC("S"))
SET GMTSDS=1
+29 if $LENGTH($GET(DIC(0)))&('$LENGTH($GET(GMTSDIC0)))
SET GMTSDIC0=$GET(DIC(0))
SET GMTSD0=1
+30 IF GMTSIF
SET GMTSIEN=$$IENF(X)
IF +GMTSIEN>0
DO IENS(GMTSIEN)
if $DATA(^TMP("GMTSULT",$JOB,1))
GOTO LQ
+31 IF GMTSBI
DO B^GMTSULT7
GOTO LQ
+32 DO PAR
DO FND
DO REO^GMTSULT3
+33 QUIT
LQ ; Quit List
+1 if +($GET(GMTSDS))>0
KILL GMTSDICS
if +($GET(GMTSD0))>0
KILL GMTSDIC0
+2 QUIT
+3 ;
FND ; Find Health Summary Types (word search)
+1 NEW GMTSB,GMTSC,GMTSCTL,GMTSFND,GMTSI,GMTSI1,GMTSI2,GMTSI3,GMTSDS,GMTSD0,GMTSLEX,GMTSLEXM,GMTSASM,GMTSCMP,GMTSLOC,GMTSNAM,GMTSOK,GMTSRC,GMTSOW,GMTSTMP,GMTSTTL,GMTSWDS,GMTSRD,GMTSWRD,Y
+2 ; Echo E or broker
+3 SET GMTSTMP=+($GET(GMTSE))
SET GMTSIF=0
if '$DATA(GMTSE)
SET GMTSTMP=$$ECHO^GMTSULT
NEW GMTSE
SET GMTSE=GMTSTMP
SET U="^"
+4 ; Exact Match X
+5 SET GMTSLEX=$$EM(X)
if $GET(GMTSDIC0)["X"&(GMTSLEX'>0)
DO CLR^GMTSULT
if $GET(GMTSDIC0)["X"&(GMTSLEX'>0)
GOTO FNDQ
+6 if +GMTSLEX>0
SET ^TMP("GMTSULT2",$JOB,"EM")=+GMTSLEX
SET ^TMP("GMTSULT2",$JOB,"IEN",+GMTSLEX)=""
+7 ; One Exact Match OE
+8 SET GMTSLEXM=0
if $GET(GMTSDIC0)["O"&($GET(GMTSDIC0)["E")
SET GMTSLEXM=1
+9 ; Word Search
+10 SET GMTSWDS=$ORDER(GMTSWRDS(" "),-1)
SET GMTSWRD=$GET(GMTSWRDS(1))
+11 if '$LENGTH(GMTSWRD)
GOTO FNDQ
SET GMTSCTL=GMTSWRD
SET GMTSWRD=$EXTRACT(GMTSWRD,1,($LENGTH(GMTSWRD)-1))_$CHAR($ASCII($EXTRACT(GMTSWRD,$LENGTH(GMTSWRD)))-1)_"~"
+12 if +GMTSCTL=GMTSCTL
SET GMTSWRD=GMTSCTL-1
+13 FOR
SET GMTSWRD=$ORDER(^GMT(142,"AW",GMTSWRD))
if GMTSWRD=""!($EXTRACT(GMTSWRD,1,$LENGTH(GMTSCTL))'=GMTSCTL)
QUIT
Begin DoDot:1
+14 SET (GMTSC,GMTSI1)=0
+15 FOR
SET GMTSI1=$ORDER(^GMT(142,"AW",GMTSWRD,GMTSI1))
if +GMTSI1=0
QUIT
Begin DoDot:2
+16 NEW GMTSIEN,GMTSKWRD
SET GMTSIEN=GMTSI1
SET GMTSKWRD=GMTSWRD
+17 DO SM^GMTSULT3
End DoDot:2
End DoDot:1
+18 ; Check for exact match in results
+19 SET GMTSI=+($GET(^TMP("GMTSULT2",$JOB,"EMI")))
+20 SET GMTSB=$GET(^TMP("GMTSULT2",$JOB,"EMB"))
IF GMTSI>0
IF $LENGTH(GMTSB)>0
Begin DoDot:1
+21 SET ^TMP("GMTSULT2",$JOB,"E")=$GET(^TMP("GMTSULT2",$JOB,GMTSI))
+22 KILL ^TMP("GMTSULT2",$JOB,GMTSI),^TMP("GMTSULT2",$JOB,"B",GMTSB),^TMP("GMTSULT2",$JOB,"EMB"),^TMP("GMTSULT2",$JOB,"EMI"),^TMP("GMTSULT2",$JOB,"EM")
End DoDot:1
FNDQ ; Find Quit
+1 if +($GET(GMTSDS))>0
KILL GMTSDICS
if +($GET(GMTSD0))>0
KILL GMTSDIC0
+2 QUIT
+3 ;
PAR ; Parse User Input
+1 KILL GMTSWRDS
NEW GMTSC,GMTSCT,GMTSPSN,GMTSTR,GMTSWRD
+2 SET U="^"
SET GMTSTR=$GET(X)
if '$LENGTH(GMTSTR)
QUIT
SET GMTSC=1
SET GMTSCT=0
FOR GMTSPSN=1:1:$LENGTH(GMTSTR)+1
Begin DoDot:1
+3 SET GMTSWRD=$EXTRACT(GMTSTR,GMTSPSN)
IF "(,.?! '-/&:;)"[GMTSWRD
Begin DoDot:2
+4 SET GMTSWRD=$TRANSLATE($EXTRACT($EXTRACT(GMTSTR,GMTSC,GMTSPSN-1),1,30),"""","")
SET GMTSC=GMTSPSN+1
+5 IF $LENGTH(GMTSWRD)>0
SET GMTSCT=GMTSCT+1
SET GMTSWRDS(GMTSCT)=$$UP(GMTSWRD)
End DoDot:2
End DoDot:1
+6 QUIT
IENF(X) ; Internal Entry Number Find
+1 NEW GMTS0,GMTSI
SET GMTSI=$GET(X)
SET X=$GET(X)
SET GMTS0=$GET(DIC(0))
if $EXTRACT(X,1)="`"
SET GMTSI=$EXTRACT(GMTSI,2,$LENGTH(GMTSI))
SET GMTSI=+GMTSI
+2 IF GMTS0["N"
IF +GMTSI>0
IF $DATA(^GMT(142,+GMTSI,0))
SET X=+GMTSI
QUIT X
+3 IF $EXTRACT(X,1)="`"
IF +GMTSI>0
IF $DATA(^GMT(142,+GMTSI,0))
SET X=+GMTSI
QUIT X
+4 QUIT -1
IENS(X) ; Internal Entry Number Save
+1 NEW GMTSI1,GMTSI2,GMTSI3,GMTSIEN
SET (GMTSIEN,GMTSI1)=+X
if +GMTSI1=0
QUIT
if '$DATA(^GMT(142,+GMTSI1,0))
QUIT
+2 DO SM^GMTSULT3
DO REO^GMTSULT3
+3 QUIT
CM(X) ; Get Number of Components
+1 SET X=+($GET(X))
if X=0
QUIT "No components"
if '$DATA(^GMT(142,+X,1))
QUIT "No components"
+2 NEW GMTSI,GMTSC
SET (GMTSC,GMTSI)=0
FOR
SET GMTSI=$ORDER(^GMT(142,+X,1,GMTSI))
if +GMTSI=0
QUIT
SET GMTSC=GMTSC+1
+3 SET X=$SELECT(+GMTSC>1:(+GMTSC_" components"),+GMTSC=1:(+GMTSC_" component"),1:"No components")
+4 QUIT X
EM(X) ; Exact Match when DIC(0) contains X
+1 SET X=$GET(X)
if '$LENGTH(X)
QUIT -1
NEW GMTSC,GMTSI,GMTSM,GMTSN,GMTSO,GMTSU
SET U="^"
+2 SET GMTSU=$$UP(X)
SET (GMTSC,GMTSO)=$$UP($EXTRACT(X,1,30))
SET GMTSM=0
SET GMTSO=$EXTRACT(GMTSO,1,($LENGTH(GMTSO)-1))_$CHAR($ASCII($EXTRACT(GMTSO,$LENGTH(GMTSO)))-1)_"~"
SET GMTSM=0
+3 FOR
SET GMTSO=$ORDER(^GMT(142,"AB",GMTSO))
if GMTSO=""!(GMTSO'[GMTSC)
QUIT
Begin DoDot:1
+4 SET GMTSI=0
FOR
SET GMTSI=$ORDER(^GMT(142,"AB",GMTSO,GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:2
+5 SET GMTSN=$PIECE($GET(^GMT(142,+GMTSI,0)),U,1)
if $$UP(GMTSN)=GMTSU
SET GMTSM=GMTSI_U_GMTSN
End DoDot:2
if +GMTSM>0
QUIT
End DoDot:1
if +GMTSM>0
QUIT
+6 if +GMTSM=0
SET GMTSM=-1
SET X=GMTSM
DO Y^GMTSULT6(+GMTSM)
+7 QUIT X
+8 ;
DICS(S,X,DA) ; Check DIC("S") Screen
+1 NEW Y,GMTST,GMTSOX,GMTSDICS,GMTSIEN
SET (GMTSIEN,Y,DA)=+($GET(DA))
SET GMTSDICS=$GET(S)
SET GMTSOX=$GET(X)
SET X=GMTSDICS
if '$LENGTH(GMTSDICS)
QUIT 1
+2 DO ^DIM
if '$LENGTH($GET(X))
QUIT 1
SET GMTST=$GET(^GMT(142,+GMTSIEN,0))
if '$DATA(^GMT(142,+GMTSIEN,0))
QUIT 0
SET X=GMTSOX
SET (Y,DA)=GMTSIEN
if GMTSIEN'>0
QUIT 0
+3 XECUTE GMTSDICS
SET X=$TEST
QUIT X
+4 ;
+5 ; Processing flags
EMQ(X) ; Exact match flag
+1 NEW GMTS0
SET X=0
SET GMTS0=$GET(DIC(0))
if '$LENGTH(GMTS0)
QUIT X
+2 if $GET(GMTS0)["X"
SET X=1
QUIT X
EMO(X) ; Exact match flag, only one
+1 NEW GMTS0
SET X=0
SET GMTS0=$GET(DIC(0))
if '$LENGTH(GMTS0)
QUIT X
+2 if $GET(GMTS0)["O"&($GET(GMTS0)["E")
SET X=1
QUIT X
BI(X) ; Use the B Index flag
+1 NEW GMTS0
SET X=0
SET GMTS0=$GET(DIC(0))
if '$LENGTH(GMTS0)
QUIT X
+2 if $GET(GMTS0)["B"
SET X=1
QUIT X
IF(X) ; Internal Entry Number Flag
+1 NEW GMTS0,GMTSI
SET GMTSI=0
SET GMTS0=$GET(DIC(0))
if '$LENGTH($GET(X))
QUIT 0
+2 IF $EXTRACT(X,1)="`"
IF $LENGTH($GET(^GMT(142,+($EXTRACT(X,2,$LENGTH(X))),0)))
SET GMTSI=1
+3 IF +X>0
IF $LENGTH($GET(^GMT(142,+X,0)))
IF GMTS0["N"
SET GMTSI=1
+4 SET X=GMTSI
QUIT X
+5 ;
+6 ; TMP Global
TMP ; Show first ^TMP Global
+1 NEW GMTSND,GMTSNC,GMTSNQ,GMTSC,GMTSTMP
+2 SET GMTSC=0
SET GMTSTMP=""
SET GMTSNQ="^TMP(""GMTSULT2"","_$JOB_")"
SET GMTSNC="^TMP(""GMTSULT2"","_$JOB_","
+3 FOR
SET GMTSNQ=$QUERY(@GMTSNQ)
if GMTSNQ=""!(GMTSNQ'[GMTSNC)
QUIT
Begin DoDot:1
+4 SET GMTSC=GMTSC+1
if GMTSC=1
WRITE !
SET GMTSND=@GMTSNQ
WRITE !,GMTSNQ,"=",GMTSND
End DoDot:1
+5 if GMTSC>0
WRITE !
TMP2 ; Show second ^TMP Global
+1 SET GMTSC=0
SET GMTSNQ="^TMP(""GMTSULT"","_$JOB_")"
SET GMTSNC="^TMP(""GMTSULT"","_$JOB_","
+2 FOR
SET GMTSNQ=$QUERY(@GMTSNQ)
if GMTSNQ=""!(GMTSNQ'[GMTSNC)
QUIT
Begin DoDot:1
+3 SET GMTSC=GMTSC+1
if '$DATA(GMTSTMP)&(GMTSC=1)
WRITE !
SET GMTSND=@GMTSNQ
WRITE !,GMTSNQ,"=",GMTSND
End DoDot:1
+4 if GMTSC>0
WRITE !
+5 QUIT
+6 ; 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)
