| [613] | 1 | GMTSULT5 ; SLC/KER - HS Type Lookup (User Input) ; 01/06/2003
|
|---|
| 2 | ;;2.7;Health Summary;**30,35,56,58**;Oct 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 10026 ^DIR
|
|---|
| 6 | ; DBIA 10006 ^DIC (file #142)
|
|---|
| 7 | ; DBIA 10060 ^VA(200,
|
|---|
| 8 | ; DBIA 2056 $$GET1^DIQ (file #200)
|
|---|
| 9 | ;
|
|---|
| 10 | Q
|
|---|
| 11 | INPUT(X) ; Get User's Input
|
|---|
| 12 | N Y,GMTSDISV,GMTSB,GMTSD,DIR S GMTSDISV=0 D GDISV
|
|---|
| 13 | S DIR(0)="FAO^1:30^N GMTS S X=$$DEF^GMTSULT5(X),GMTS=$$INPT^GMTSULT5(X) K:'GMTS X"
|
|---|
| 14 | S DIR("?")="^D IN1^GMTSULT5",DIR("??")="^D IN2^GMTSULT5"
|
|---|
| 15 | S:'$L($G(GMTSDICA)) DIR("A")="Select HEALTH SUMMARY TYPE: " S:$L($G(GMTSDICA)) DIR("A")=GMTSDICA
|
|---|
| 16 | S GMTSD=0 S:$L($G(GMTSDICB)) DIR("A")=DIR("A")_$G(GMTSDICB)_"// "
|
|---|
| 17 | I $L($G(DIR("B"))) W !,DIR("A") S X=DIR("B") Q X
|
|---|
| 18 | D ^DIR K:X=""&($L($G(GMTSDICB)))&('$D(DTOUT)) DIRUT
|
|---|
| 19 | S:X=""&($L($G(GMTSDICB))) (X,Y)=GMTSDICB,GMTSDEF=1 Q:$D(DTOUT)!($D(DUOUT)) X
|
|---|
| 20 | S:X=" "&($L(Y))&($G(GMTSDIC0)'["F")&(+GMTSDISV>0)&($L($P($G(^GMT(142,+GMTSDISV,0)),"^",1))) X="`"_GMTSDISV
|
|---|
| 21 | Q X
|
|---|
| 22 | ;
|
|---|
| 23 | ; Help
|
|---|
| 24 | IN1 ; Single Question Mark Help ? for User Input
|
|---|
| 25 | 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
|
|---|
| 26 | I X=" "&($G(GMTSDIC0)'["F") D Q
|
|---|
| 27 | . D GDISV
|
|---|
| 28 | . S:+($G(GMTSDISV))>0 X=$P($G(^GMT(142,+($G(GMTSDISV)),0)),U,1),(Y,GMTSD)=+GMTSDISV
|
|---|
| 29 | D GHT Q
|
|---|
| 30 | IN2 ; Double Question Mark Help ? with listing
|
|---|
| 31 | 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
|
|---|
| 32 | W !!,"Choose from:"
|
|---|
| 33 | N GMTSHS,GMTSC,GMTSCT,GMTSIEN,GMTSOK,GMTSTR,GMTSTL,GMTST,GMTSPL,GMTSTT,GMTSRR
|
|---|
| 34 | S (GMTSC,GMTST)=0,GMTSCT=1,GMTSHS="",GMTSPL=+($G(IOSL))-8 S:GMTSPL'>0 GMTSPL=18
|
|---|
| 35 | 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
|
|---|
| 36 | S GMTSRR=GMTSTT F S GMTSHS=$O(^GMT(142,"B",GMTSHS)) Q:GMTSHS=""!('GMTSCT) Q:GMTST>0 D Q:'GMTSCT Q:GMTST>0
|
|---|
| 37 | . 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
|
|---|
| 38 | . . S GMTSTL="",GMTSOK=1,GMTSTR=$P($G(^GMT(142,GMTSIEN,0)),U,1) Q:'$L(GMTSTR)
|
|---|
| 39 | . . S GMTSOK=1 I $L($G(GMTSDICS)) S GMTSOK=$$DICS^GMTSULT2(GMTSDICS,X,GMTSIEN) Q:'GMTSOK
|
|---|
| 40 | . . F Q:$L(GMTSTR)>33 S GMTSTR=GMTSTR_" "
|
|---|
| 41 | . . S GMTSTL=$P($G(^GMT(142,GMTSIEN,"T")),U,1)
|
|---|
| 42 | . . S:$L(GMTSTL) GMTSTR=GMTSTR_GMTSTL
|
|---|
| 43 | . . S GMTSC=GMTSC+1,GMTSRR=GMTSRR-1 W !,?3,GMTSTR I +GMTSC>GMTSPL D IN2C S GMTSC=0
|
|---|
| 44 | W ! D:GMTST'>1 GHT Q
|
|---|
| 45 | IN2C ; Ask to Continue Listing
|
|---|
| 46 | N X W !,?3,"""^"" TO STOP:" R X:300
|
|---|
| 47 | S:'$T!(X["^") GMTSC=0 S:X["^" GMTST=1
|
|---|
| 48 | S:X["^^" GMTST=2 Q
|
|---|
| 49 | GHT ; General Help Text
|
|---|
| 50 | W !,?5,"Answer with Health Summary Type name, title, owner or hospital"
|
|---|
| 51 | W !,?5,"location using the summary. Your response must be at least 2"
|
|---|
| 52 | W !,?5,"characters and no more than 30 characters and must not contain"
|
|---|
| 53 | W !,?5,"an embedded uparrow" Q
|
|---|
| 54 | ;
|
|---|
| 55 | ; Defaults values
|
|---|
| 56 | DEF(X) ; Default
|
|---|
| 57 | S X=$G(X)
|
|---|
| 58 | I +X>0,$D(^GMT(142,+X,0)),($G(GMTSDIC0)["N"!($G(GMTSDIC0)["N")) D Q X
|
|---|
| 59 | . S (Y,GMTSD)=+X,X=$P($G(^GMT(142,+Y,0)),U,1)
|
|---|
| 60 | I $E(X,1)="`",+($E(X,2,$L(X)))>0,$D(^GMT(142,+($E(X,2,$L(X))),0)) D Q X
|
|---|
| 61 | . S (Y,GMTSD)=+($E(X,2,$L(X))),X=$P($G(^GMT(142,+Y,0)),U,1)
|
|---|
| 62 | I X=" "&($G(GMTSDIC0)'["F") D
|
|---|
| 63 | . D GDISV S:+($G(GMTSDISV))>0 X=$P($G(^GMT(142,+($G(GMTSDISV)),0)),U,1),(Y,GMTSD)=+GMTSDISV
|
|---|
| 64 | Q X
|
|---|
| 65 | GDISV ; Get Default Value (Spacebar-Return)
|
|---|
| 66 | 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
|
|---|
| 67 | Q:+($G(DUZ))=0 Q:'$L($$GET1^DIQ(200,(+($G(DUZ))_","),.01)) S DIC=142,DIC(0)="Z",X=" ",GMTSOK=1 D ^DIC
|
|---|
| 68 | S:$L($G(GMTSDICS)) GMTSOK=$$DICS^GMTSULT2($G(GMTSDICS),$G(X),+($G(Y))) S:+GMTSOK'>0 Y=-1
|
|---|
| 69 | S GMTSDISV=$S(+Y>0:+Y,1:"")
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | ; Miscellaneous
|
|---|
| 73 | INPT(X) ; Input Transform
|
|---|
| 74 | 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
|
|---|
| 75 | N GMTSINPT,GMTSI,GMTST S (GMTST,X)=$G(X) I $L(X)=1,X'=" " Q 0
|
|---|
| 76 | I X=" "&($G(GMTSDIC0)'["F") D
|
|---|
| 77 | . D GDISV S:+($G(GMTSDISV))>0 X=$P($G(^GMT(142,+($G(GMTSDISV)),0)),U,1),(Y,GMTSD)=+GMTSDISV
|
|---|
| 78 | K ^TMP("GMTSULT",$J),^TMP("GMTSULT2",$J) S GMTSINPT="" D LIST^GMTSULT2(X) S X=$S($D(^TMP("GMTSULT",$J,0)):1,1:0)
|
|---|
| 79 | I +X=0,$L($G(GMTST))>2,$L($G(GMTST))<31,+($G(GMTSLGO))=142,$G(GMTSDIC0)["L" S X=1 Q X
|
|---|
| 80 | K ^TMP("GMTSULT",$J),^TMP("GMTSULT2",$J) Q X
|
|---|
