1 | GMTSULT6 ; SLC/KER - HS Type Lookup (Select) ; 08/27/2002
|
---|
2 | ;;2.7;Health Summary;**30,32,56**;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 | ; DBIA 10016 ^DIM
|
---|
10 | ; DBIA 2055 RECALL^DILFD
|
---|
11 | Q
|
---|
12 | ;
|
---|
13 | MULTI ; Selection when Multiple Entries are found
|
---|
14 | I $L($G(GMTSDICB)),GMTSDEF=1 D DEF Q
|
---|
15 | S GMTSDICW=$$DICW($G(GMTSDICW)) K:'$L(GMTSDICW) GMTSDICW
|
---|
16 | N GMTSIEN,GMTSE,GMTSO,GMTST,GMTSTOT,GMTSM S GMTSTOT=^TMP("GMTSULT",$J,0) Q:+GMTSTOT=0 I +GMTSTOT=1 D ONE Q
|
---|
17 | W ! W:+GMTSTOT>1 !,GMTSTOT," Health Summary Types found"
|
---|
18 | N GMTSI,GMTSS,GMTSEX,X,GMTSTR,GMTSTR2,GMTSTR3,GMTSLEN S GMTSLEN=75,GMTSS=0,GMTSEX=0
|
---|
19 | ; List 5 at a time
|
---|
20 | F GMTSI=1:1:^TMP("GMTSULT",$J,0) Q:((GMTSS>0)&(GMTSS<GMTSI+1)) Q:GMTSEX D Q:GMTSEX
|
---|
21 | . S GMTSE=$G(^TMP("GMTSULT",$J,GMTSI))
|
---|
22 | . S GMTSM=GMTSI W:GMTSI#5=1 ! W !,$J(GMTSI,4),". "
|
---|
23 | . S GMTSIEN=+GMTSE,(GMTST,GMTSTR)=$P(GMTSE,U,7),GMTSO=$P(GMTSE,U,2)
|
---|
24 | . S:'$L(GMTSTR)&($L(GMTSO)) GMTSTR=GMTSO
|
---|
25 | . D WRM1
|
---|
26 | . W:GMTSI#5=0 ! S:GMTSI#5=0 GMTSS=$$SEL(GMTSM) S:GMTSS["^" GMTSEX=1
|
---|
27 | I GMTSI#5'=0,+GMTSS=0 W ! S GMTSS=$$SEL(GMTSM) S:GMTSS["^" GMTSEX=1
|
---|
28 | I 'GMTSEX,+GMTSS>0 D Q
|
---|
29 | . N GMTSNAM K Y S Y=+($G(^TMP("GMTSULT",$J,+GMTSS)))
|
---|
30 | . S GMTSNAM=$P($G(^GMT(142,+Y,0)),"^",1) I '$L(GMTSNAM) K Y S Y=-1 Q
|
---|
31 | . D Y(+Y)
|
---|
32 | K Y S Y=-1
|
---|
33 | Q
|
---|
34 | WRM1 ; Write one entry of muli selection
|
---|
35 | N Y,GMTS S Y=+GMTSIEN,GMTS=$G(^GMT(142,+Y,0))
|
---|
36 | I '$D(GMTSDICW) W:$L(GMTSTR)'>GMTSLEN GMTSTR D:$L(GMTSTR)>GMTSLEN LONG Q
|
---|
37 | I $D(GMTSDICW),$G(GMTSDIC0)'["S" W $P(GMTS,"^",1)," " X GMTSDICW Q
|
---|
38 | I $D(GMTSDICW),$G(GMTSDIC0)["S" X GMTSDICW Q
|
---|
39 | Q
|
---|
40 | SEL(X) ; Select multiple
|
---|
41 | N Y,GMTSM,DTOUT,DUOUT,DIRUT,DIROUT S GMTSM=+($G(X)) Q:GMTSM=0 -1
|
---|
42 | S:+($O(^TMP("GMTSULT",$J,+($G(GMTSI)))))>0 DIR("A")="Press <RETURN> for more, '^' to exit, or Select 1-"_GMTSM_": "
|
---|
43 | S:+($O(^TMP("GMTSULT",$J,+($G(GMTSI)))))'>0 DIR("A")="Select 1-"_GMTSM_": "
|
---|
44 | S (DIR("?"),DIR("??"))="Answer must be from 1 to "_GMTSM_", or <Return> to continue "
|
---|
45 | S DIR(0)="NAO^1:"_GMTSM_":0" D ^DIR S:$D(DTOUT)!(X[U) X=U K DIR Q X
|
---|
46 | Q
|
---|
47 | ;
|
---|
48 | ONE ; One entry on the selection list
|
---|
49 | I $L($G(GMTSDICB)),GMTSDEF=1 D DEF Q
|
---|
50 | N GMTSEX,GMTSIEN,GMTSTR,GMTSTR2,GMTSY,GMTSX,GMTSLEN,DIR,X
|
---|
51 | S GMTSLEN=75,Y=0 S:GMTSQ!($G(GMTSDIC0)["E") GMTSQ=1,Y=1
|
---|
52 | S GMTSEX=0
|
---|
53 | ; No Echo or if Ask
|
---|
54 | S GMTSIEN=+($G(^TMP("GMTSULT",$J,1)))
|
---|
55 | I 'GMTSQ!($G(GMTSDIC0)["A") D
|
---|
56 | . N X S GMTSTR=$P($G(^TMP("GMTSULT",$J,1)),U,7)
|
---|
57 | . S:'$L(GMTSTR) GMTSTR=$P($G(^TMP("GMTSULT",$J,1)),U,2)
|
---|
58 | . D WRO1 S Y=$$OK S:Y["^" GMTSEX=1
|
---|
59 | I 'GMTSEX,+Y>0 D Q
|
---|
60 | . N GMTSNAM K Y S Y=+($G(^TMP("GMTSULT",$J,1)))
|
---|
61 | . S GMTSNAM=$P($G(^GMT(142,+Y,0)),"^",1) I '$L(GMTSNAM) K Y S Y=-1 Q
|
---|
62 | . D Y(+Y)
|
---|
63 | K Y S Y=-1
|
---|
64 | Q
|
---|
65 | WRO1 ; Write one entry of single selection
|
---|
66 | W !!," " N Y,GMTS S Y=+GMTSIEN,GMTS=$G(^GMT(142,+Y,0))
|
---|
67 | I '$D(GMTSDICW) W:$L(GMTSTR)'>GMTSLEN GMTSTR D:$L(GMTSTR)>GMTSLEN LONG W ! Q
|
---|
68 | I $D(GMTSDICW),$G(GMTSDIC0)'["S" W $P(GMTS,"^",1)," " X GMTSDICW W ! Q
|
---|
69 | I $D(GMTSDICW),$G(GMTSDIC0)["S" X GMTSDICW W ! Q
|
---|
70 | Q
|
---|
71 | OK(X) ; Select one if DIC(0)["A" Ask OK
|
---|
72 | N DIR,DTOUT,DUOUT,DIROUT S DIR(0)="YAO",DIR("B")="YES"
|
---|
73 | S DIR("A")=" OK? " D ^DIR S:X'["^" X=+Y S:$D(DTOUT)!($D(DUOUT)) X="^" S:X["^" X="^" Q X
|
---|
74 | ;
|
---|
75 | DEF ; Select Default Entry
|
---|
76 | N GMTSNAM K Y S Y=+($G(^TMP("GMTSULT",$J,1)))
|
---|
77 | S GMTSNAM=$P($G(^GMT(142,+Y,0)),"^",1) I '$L(GMTSNAM) K Y S Y=-1 Q
|
---|
78 | D Y(+Y)
|
---|
79 | Q
|
---|
80 | ;
|
---|
81 | ; Display
|
---|
82 | LONG ; Handle a long string
|
---|
83 | N GMTSP,GMTSOK,GMTSCHR,GMTSPSN,GMTSTO,GMTSREM,GMTSLN,GMTSOLD S GMTSLN=0,GMTSOLD=GMTSTR,GMTSP=5
|
---|
84 | F Q:$L(GMTSTR)<(GMTSLEN+1) D PARSE Q:$L(GMTSTR)<(GMTSLEN+1)
|
---|
85 | S GMTSLN=GMTSLN+1 W:GMTSLN>1 ! W ?GMTSP,GMTSTR
|
---|
86 | Q
|
---|
87 | PARSE ; Parse a long string to screen length
|
---|
88 | S GMTSOK=0,GMTSCHR="" F GMTSPSN=GMTSLEN:-1:0 Q:+GMTSOK=1 D Q:+GMTSOK=1
|
---|
89 | . I $E(GMTSTR,GMTSPSN)=" " S GMTSCHR=" ",GMTSOK=1 Q
|
---|
90 | . I $E(GMTSTR,GMTSPSN)="," S GMTSCHR=",",GMTSOK=1 Q
|
---|
91 | . I $E(GMTSTR,GMTSPSN)="/" S GMTSCHR="/",GMTSOK=1 Q
|
---|
92 | . I $E(GMTSTR,GMTSPSN)="-" S GMTSCHR="-",GMTSOK=1 Q
|
---|
93 | I GMTSCHR=" " S GMTSTO=$E(GMTSTR,1,GMTSPSN-1),GMTSREM=$E(GMTSTR,GMTSPSN+1,$L(GMTSTR))
|
---|
94 | I GMTSCHR="," S GMTSTO=$E(GMTSTR,1,GMTSPSN),GMTSREM=$E(GMTSTR,(GMTSPSN+1),$L(GMTSTR)) S:$E(GMTSREM,1)=" " GMTSREM=$E(GMTSREM,2,$L(GMTSREM))
|
---|
95 | I GMTSCHR="/" S GMTSTO=$E(GMTSTR,1,GMTSPSN),GMTSREM=$E(GMTSTR,(GMTSPSN+1),$L(GMTSTR)) S:$E(GMTSREM,1)=" " GMTSREM=$E(GMTSREM,2,$L(GMTSREM))
|
---|
96 | I GMTSCHR="-" S GMTSTO=$E(GMTSTR,1,GMTSPSN),GMTSREM=$E(GMTSTR,(GMTSPSN+1),$L(GMTSTR)) S:$E(GMTSREM,1)=" " GMTSREM=$E(GMTSREM,2,$L(GMTSREM))
|
---|
97 | S GMTSTR=GMTSREM,GMTSLN=GMTSLN+1 W:GMTSLN>1 ! W ?GMTSP,GMTSTO
|
---|
98 | Q
|
---|
99 | DICW(X) ; Check for valid DIC("W")
|
---|
100 | S X=$G(X) Q:'$L(X) ""
|
---|
101 | D ^DIM I '$D(X) Q ""
|
---|
102 | Q X
|
---|
103 | ;
|
---|
104 | ; Post Selection
|
---|
105 | Y(X) ; Set Y
|
---|
106 | K Y S X=+($G(X))
|
---|
107 | S:X'>0!('$D(^GMT(142,+X,0))) Y=-1 Q:X'>0!('$D(^GMT(142,+X,0)))
|
---|
108 | S Y=+X_"^"_$P($G(^GMT(142,+X,0)),"^",1)
|
---|
109 | S:$G(GMTSDIC0)["Z"!($G(DIC(0))["Z") Y(0)=$G(^GMT(142,+X,0)),Y(0,0)=$P($G(^GMT(142,+X,0)),"^",1),Y(0,1)=$$MX(Y(0,0))
|
---|
110 | I +($G(GMTSWY))=0 W:$G(GMTSDIC0)["E"!($G(DIC(0))["E") " ",$P($G(^GMT(142,+X,0)),"^",1) S GMTSWY=1
|
---|
111 | D:$G(GMTSDIC0)'["F"&($G(DIC(0))'["F") SDISV
|
---|
112 | Q
|
---|
113 | SDISV ; Save Default Value (Spacebar-Return)
|
---|
114 | Q:$G(GMTSDIC0)["F" Q:+($G(DUZ))=0 Q:'$L($$GET1^DIQ(200,(+($G(DUZ))_","),.01)) Q:+($G(Y))=0 Q:'$D(^GMT(142,+($G(Y)),0))
|
---|
115 | D RECALL^DILFD(142,+($G(Y))_",",+($G(DUZ))) Q
|
---|
116 | Q
|
---|
117 | MX(X) ; Mix Case
|
---|
118 | Q $$EN^GMTSUMX(X)
|
---|