GMTSULT5 ; SLC/KER - HS Type Lookup (User Input) ; 01/06/2003
;;2.7;Health Summary;**30,35,56,58**;Oct 20, 1995
;
; External References
; DBIA 10026 ^DIR
; DBIA 10006 ^DIC (file #142)
; DBIA 10060 ^VA(200,
; DBIA 2056 $$GET1^DIQ (file #200)
;
Q
INPUT(X) ; Get User's Input
N Y,GMTSDISV,GMTSB,GMTSD,DIR S GMTSDISV=0 D GDISV
S DIR(0)="FAO^1:30^N GMTS S X=$$DEF^GMTSULT5(X),GMTS=$$INPT^GMTSULT5(X) K:'GMTS X"
S DIR("?")="^D IN1^GMTSULT5",DIR("??")="^D IN2^GMTSULT5"
S:'$L($G(GMTSDICA)) DIR("A")="Select HEALTH SUMMARY TYPE: " S:$L($G(GMTSDICA)) DIR("A")=GMTSDICA
S GMTSD=0 S:$L($G(GMTSDICB)) DIR("A")=DIR("A")_$G(GMTSDICB)_"// "
I $L($G(DIR("B"))) W !,DIR("A") S X=DIR("B") Q X
D ^DIR K:X=""&($L($G(GMTSDICB)))&('$D(DTOUT)) DIRUT
S:X=""&($L($G(GMTSDICB))) (X,Y)=GMTSDICB,GMTSDEF=1 Q:$D(DTOUT)!($D(DUOUT)) X
S:X=" "&($L(Y))&($G(GMTSDIC0)'["F")&(+GMTSDISV>0)&($L($P($G(^GMT(142,+GMTSDISV,0)),"^",1))) X="`"_GMTSDISV
Q X
;
; Help
IN1 ; Single Question Mark Help ? for User Input
N %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%N,%P,%S,%T,%W,%X,%Y,%BU,%J1,%A0,%W0,%D1,%D2,%DT,%K,%M
I X=" "&($G(GMTSDIC0)'["F") D Q
. D GDISV
. S:+($G(GMTSDISV))>0 X=$P($G(^GMT(142,+($G(GMTSDISV)),0)),U,1),(Y,GMTSD)=+GMTSDISV
D GHT Q
IN2 ; Double Question Mark Help ? with listing
N %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%N,%P,%S,%T,%W,%X,%Y,%BU,%J1,%A0,%W0,%D1,%D2,%DT,%K,%M
W !!,"Choose from:"
N GMTSHS,GMTSC,GMTSCT,GMTSIEN,GMTSOK,GMTSTR,GMTSTL,GMTST,GMTSPL,GMTSTT,GMTSRR
S (GMTSC,GMTST)=0,GMTSCT=1,GMTSHS="",GMTSPL=+($G(IOSL))-8 S:GMTSPL'>0 GMTSPL=18
S GMTSTT=0,GMTSHS="" F S GMTSHS=$O(^GMT(142,"B",GMTSHS)) Q:GMTSHS="" S GMTSIEN=0 F S GMTSIEN=$O(^GMT(142,"B",GMTSHS,GMTSIEN)) Q:+GMTSIEN=0 S GMTSTT=GMTSTT+1
S GMTSRR=GMTSTT F S GMTSHS=$O(^GMT(142,"B",GMTSHS)) Q:GMTSHS=""!('GMTSCT) Q:GMTST>0 D Q:'GMTSCT Q:GMTST>0
. S GMTSIEN=0 F S GMTSIEN=$O(^GMT(142,"B",GMTSHS,GMTSIEN)) Q:+GMTSIEN=0!('GMTSCT) Q:GMTST>0 D Q:'GMTSCT Q:+GMTST>0
. . S GMTSTL="",GMTSOK=1,GMTSTR=$P($G(^GMT(142,GMTSIEN,0)),U,1) Q:'$L(GMTSTR)
. . S GMTSOK=1 I $L($G(GMTSDICS)) S GMTSOK=$$DICS^GMTSULT2(GMTSDICS,X,GMTSIEN) Q:'GMTSOK
. . F Q:$L(GMTSTR)>33 S GMTSTR=GMTSTR_" "
. . S GMTSTL=$P($G(^GMT(142,GMTSIEN,"T")),U,1)
. . S:$L(GMTSTL) GMTSTR=GMTSTR_GMTSTL
. . S GMTSC=GMTSC+1,GMTSRR=GMTSRR-1 W !,?3,GMTSTR I +GMTSC>GMTSPL D IN2C S GMTSC=0
W ! D:GMTST'>1 GHT Q
IN2C ; Ask to Continue Listing
N X W !,?3,"""^"" TO STOP:" R X:300
S:'$T!(X["^") GMTSC=0 S:X["^" GMTST=1
S:X["^^" GMTST=2 Q
GHT ; General Help Text
W !,?5,"Answer with Health Summary Type name, title, owner or hospital"
W !,?5,"location using the summary. Your response must be at least 2"
W !,?5,"characters and no more than 30 characters and must not contain"
W !,?5,"an embedded uparrow" Q
;
; Defaults values
DEF(X) ; Default
S X=$G(X)
I +X>0,$D(^GMT(142,+X,0)),($G(GMTSDIC0)["N"!($G(GMTSDIC0)["N")) D Q X
. S (Y,GMTSD)=+X,X=$P($G(^GMT(142,+Y,0)),U,1)
I $E(X,1)="`",+($E(X,2,$L(X)))>0,$D(^GMT(142,+($E(X,2,$L(X))),0)) D Q X
. S (Y,GMTSD)=+($E(X,2,$L(X))),X=$P($G(^GMT(142,+Y,0)),U,1)
I X=" "&($G(GMTSDIC0)'["F") D
. D GDISV S:+($G(GMTSDISV))>0 X=$P($G(^GMT(142,+($G(GMTSDISV)),0)),U,1),(Y,GMTSD)=+GMTSDISV
Q X
GDISV ; Get Default Value (Spacebar-Return)
S GMTSDISV=0 N DIC,Y,X,DLAYGO,DINUM,DTOUT,DUOUT,GMTSOK,%,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%N,%P,%S,%T,%W,%X,%Y,%BU,%J1,%A0,%W0,%D1,%D2,%DT,%K,%M
Q:+($G(DUZ))=0 Q:'$L($$GET1^DIQ(200,(+($G(DUZ))_","),.01)) S DIC=142,DIC(0)="Z",X=" ",GMTSOK=1 D ^DIC
S:$L($G(GMTSDICS)) GMTSOK=$$DICS^GMTSULT2($G(GMTSDICS),$G(X),+($G(Y))) S:+GMTSOK'>0 Y=-1
S GMTSDISV=$S(+Y>0:+Y,1:"")
Q
;
; Miscellaneous
INPT(X) ; Input Transform
N %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%N,%P,%S,%T,%W,%X,%Y,%BU,%J1,%A0,%W0,%D1,%D2,%DT,%K,%M
N GMTSINPT,GMTSI,GMTST S (GMTST,X)=$G(X) I $L(X)=1,X'=" " Q 0
I X=" "&($G(GMTSDIC0)'["F") D
. D GDISV S:+($G(GMTSDISV))>0 X=$P($G(^GMT(142,+($G(GMTSDISV)),0)),U,1),(Y,GMTSD)=+GMTSDISV
K ^TMP("GMTSULT",$J),^TMP("GMTSULT2",$J) S GMTSINPT="" D LIST^GMTSULT2(X) S X=$S($D(^TMP("GMTSULT",$J,0)):1,1:0)
I +X=0,$L($G(GMTST))>2,$L($G(GMTST))<31,+($G(GMTSLGO))=142,$G(GMTSDIC0)["L" S X=1 Q X
K ^TMP("GMTSULT",$J),^TMP("GMTSULT2",$J) Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSULT5 4407 printed Sep 23, 2025@19:36:37 Page 2
GMTSULT5 ; SLC/KER - HS Type Lookup (User Input) ; 01/06/2003
+1 ;;2.7;Health Summary;**30,35,56,58**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 10026 ^DIR
+5 ; DBIA 10006 ^DIC (file #142)
+6 ; DBIA 10060 ^VA(200,
+7 ; DBIA 2056 $$GET1^DIQ (file #200)
+8 ;
+9 QUIT
INPUT(X) ; Get User's Input
+1 NEW Y,GMTSDISV,GMTSB,GMTSD,DIR
SET GMTSDISV=0
DO GDISV
+2 SET DIR(0)="FAO^1:30^N GMTS S X=$$DEF^GMTSULT5(X),GMTS=$$INPT^GMTSULT5(X) K:'GMTS X"
+3 SET DIR("?")="^D IN1^GMTSULT5"
SET DIR("??")="^D IN2^GMTSULT5"
+4 if '$LENGTH($GET(GMTSDICA))
SET DIR("A")="Select HEALTH SUMMARY TYPE: "
if $LENGTH($GET(GMTSDICA))
SET DIR("A")=GMTSDICA
+5 SET GMTSD=0
if $LENGTH($GET(GMTSDICB))
SET DIR("A")=DIR("A")_$GET(GMTSDICB)_"// "
+6 IF $LENGTH($GET(DIR("B")))
WRITE !,DIR("A")
SET X=DIR("B")
QUIT X
+7 DO ^DIR
if X=""&($LENGTH($GET(GMTSDICB)))&('$DATA(DTOUT))
KILL DIRUT
+8 if X=""&($LENGTH($GET(GMTSDICB)))
SET (X,Y)=GMTSDICB
SET GMTSDEF=1
if $DATA(DTOUT)!($DATA(DUOUT))
QUIT X
+9 if X=" "&($LENGTH(Y))&($GET(GMTSDIC0)'["F")&(+GMTSDISV>0)&($LENGTH($PIECE($GET(^GMT(142,+GMTSDISV,0)),"^",1)))
SET X="`"_GMTSDISV
+10 QUIT X
+11 ;
+12 ; Help
IN1 ; Single Question Mark Help ? for User Input
+1 NEW %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%N,%P,%S,%T,%W,%X,%Y,%BU,%J1,%A0,%W0,%D1,%D2,%DT,%K,%M
+2 IF X=" "&($GET(GMTSDIC0)'["F")
Begin DoDot:1
+3 DO GDISV
+4 if +($GET(GMTSDISV))>0
SET X=$PIECE($GET(^GMT(142,+($GET(GMTSDISV)),0)),U,1)
SET (Y,GMTSD)=+GMTSDISV
End DoDot:1
QUIT
+5 DO GHT
QUIT
IN2 ; Double Question Mark Help ? with listing
+1 NEW %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%N,%P,%S,%T,%W,%X,%Y,%BU,%J1,%A0,%W0,%D1,%D2,%DT,%K,%M
+2 WRITE !!,"Choose from:"
+3 NEW GMTSHS,GMTSC,GMTSCT,GMTSIEN,GMTSOK,GMTSTR,GMTSTL,GMTST,GMTSPL,GMTSTT,GMTSRR
+4 SET (GMTSC,GMTST)=0
SET GMTSCT=1
SET GMTSHS=""
SET GMTSPL=+($GET(IOSL))-8
if GMTSPL'>0
SET GMTSPL=18
+5 SET GMTSTT=0
SET GMTSHS=""
FOR
SET GMTSHS=$ORDER(^GMT(142,"B",GMTSHS))
if GMTSHS=""
QUIT
SET GMTSIEN=0
FOR
SET GMTSIEN=$ORDER(^GMT(142,"B",GMTSHS,GMTSIEN))
if +GMTSIEN=0
QUIT
SET GMTSTT=GMTSTT+1
+6 SET GMTSRR=GMTSTT
FOR
SET GMTSHS=$ORDER(^GMT(142,"B",GMTSHS))
if GMTSHS=""!('GMTSCT)
QUIT
if GMTST>0
QUIT
Begin DoDot:1
+7 SET GMTSIEN=0
FOR
SET GMTSIEN=$ORDER(^GMT(142,"B",GMTSHS,GMTSIEN))
if +GMTSIEN=0!('GMTSCT)
QUIT
if GMTST>0
QUIT
Begin DoDot:2
+8 SET GMTSTL=""
SET GMTSOK=1
SET GMTSTR=$PIECE($GET(^GMT(142,GMTSIEN,0)),U,1)
if '$LENGTH(GMTSTR)
QUIT
+9 SET GMTSOK=1
IF $LENGTH($GET(GMTSDICS))
SET GMTSOK=$$DICS^GMTSULT2(GMTSDICS,X,GMTSIEN)
if 'GMTSOK
QUIT
+10 FOR
if $LENGTH(GMTSTR)>33
QUIT
SET GMTSTR=GMTSTR_" "
+11 SET GMTSTL=$PIECE($GET(^GMT(142,GMTSIEN,"T")),U,1)
+12 if $LENGTH(GMTSTL)
SET GMTSTR=GMTSTR_GMTSTL
+13 SET GMTSC=GMTSC+1
SET GMTSRR=GMTSRR-1
WRITE !,?3,GMTSTR
IF +GMTSC>GMTSPL
DO IN2C
SET GMTSC=0
End DoDot:2
if 'GMTSCT
QUIT
if +GMTST>0
QUIT
End DoDot:1
if 'GMTSCT
QUIT
if GMTST>0
QUIT
+14 WRITE !
if GMTST'>1
DO GHT
QUIT
IN2C ; Ask to Continue Listing
+1 NEW X
WRITE !,?3,"""^"" TO STOP:"
READ X:300
+2 if '$TEST!(X["^")
SET GMTSC=0
if X["^"
SET GMTST=1
+3 if X["^^"
SET GMTST=2
QUIT
GHT ; General Help Text
+1 WRITE !,?5,"Answer with Health Summary Type name, title, owner or hospital"
+2 WRITE !,?5,"location using the summary. Your response must be at least 2"
+3 WRITE !,?5,"characters and no more than 30 characters and must not contain"
+4 WRITE !,?5,"an embedded uparrow"
QUIT
+5 ;
+6 ; Defaults values
DEF(X) ; Default
+1 SET X=$GET(X)
+2 IF +X>0
IF $DATA(^GMT(142,+X,0))
IF ($GET(GMTSDIC0)["N"!($GET(GMTSDIC0)["N"))
Begin DoDot:1
+3 SET (Y,GMTSD)=+X
SET X=$PIECE($GET(^GMT(142,+Y,0)),U,1)
End DoDot:1
QUIT X
+4 IF $EXTRACT(X,1)="`"
IF +($EXTRACT(X,2,$LENGTH(X)))>0
IF $DATA(^GMT(142,+($EXTRACT(X,2,$LENGTH(X))),0))
Begin DoDot:1
+5 SET (Y,GMTSD)=+($EXTRACT(X,2,$LENGTH(X)))
SET X=$PIECE($GET(^GMT(142,+Y,0)),U,1)
End DoDot:1
QUIT X
+6 IF X=" "&($GET(GMTSDIC0)'["F")
Begin DoDot:1
+7 DO GDISV
if +($GET(GMTSDISV))>0
SET X=$PIECE($GET(^GMT(142,+($GET(GMTSDISV)),0)),U,1)
SET (Y,GMTSD)=+GMTSDISV
End DoDot:1
+8 QUIT X
GDISV ; Get Default Value (Spacebar-Return)
+1 SET GMTSDISV=0
NEW DIC,Y,X,DLAYGO,DINUM,DTOUT,DUOUT,GMTSOK,%,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%N,%P,%S,%T,%W,%X,%Y,%BU,%J1,%A0,%W0,%D1,%D2,%DT,%K,%M
+2 if +($GET(DUZ))=0
QUIT
if '$LENGTH($$GET1^DIQ(200,(+($GET(DUZ))_","),.01))
QUIT
SET DIC=142
SET DIC(0)="Z"
SET X=" "
SET GMTSOK=1
DO ^DIC
+3 if $LENGTH($GET(GMTSDICS))
SET GMTSOK=$$DICS^GMTSULT2($GET(GMTSDICS),$GET(X),+($GET(Y)))
if +GMTSOK'>0
SET Y=-1
+4 SET GMTSDISV=$SELECT(+Y>0:+Y,1:"")
+5 QUIT
+6 ;
+7 ; Miscellaneous
INPT(X) ; Input Transform
+1 NEW %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%N,%P,%S,%T,%W,%X,%Y,%BU,%J1,%A0,%W0,%D1,%D2,%DT,%K,%M
+2 NEW GMTSINPT,GMTSI,GMTST
SET (GMTST,X)=$GET(X)
IF $LENGTH(X)=1
IF X'=" "
QUIT 0
+3 IF X=" "&($GET(GMTSDIC0)'["F")
Begin DoDot:1
+4 DO GDISV
if +($GET(GMTSDISV))>0
SET X=$PIECE($GET(^GMT(142,+($GET(GMTSDISV)),0)),U,1)
SET (Y,GMTSD)=+GMTSDISV
End DoDot:1
+5 KILL ^TMP("GMTSULT",$JOB),^TMP("GMTSULT2",$JOB)
SET GMTSINPT=""
DO LIST^GMTSULT2(X)
SET X=$SELECT($DATA(^TMP("GMTSULT",$JOB,0)):1,1:0)
+6 IF +X=0
IF $LENGTH($GET(GMTST))>2
IF $LENGTH($GET(GMTST))<31
IF +($GET(GMTSLGO))=142
IF $GET(GMTSDIC0)["L"
SET X=1
QUIT X
+7 KILL ^TMP("GMTSULT",$JOB),^TMP("GMTSULT2",$JOB)
QUIT X
