| 1 | DIC11 ;SFISC/TKW-PROMPT USER FOR LOOKUP VALUES ;1:33 PM 26 Dec 2000
|
|---|
| 2 | ;;22.0;VA FileMan;**1,13,40,67**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | PROMPT N DIOUT S (DIVAL(0),DIOUT)=0
|
|---|
| 5 | F DISUB=1:1:DINDEX("#") D PR1 Q:DIOUT
|
|---|
| 6 | S X=$G(DIVAL(1))
|
|---|
| 7 | I DINDEX("#")>1 M X=DIVAL D K X(0) ; W:$O(DIVAL(1)) !
|
|---|
| 8 | . I X?1"^"1.E K X S X=$G(DIVAL(1)) Q
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | PR1 S DIY=DIPRMT(DISUB),DIVAL(DISUB)="" N X
|
|---|
| 12 | I $G(DIY(DISUB))]"" S DIY=DIY_$S($D(DIY(DISUB,"EXT")):DIY(DISUB,"EXT"),1:DIY(DISUB))_"// "
|
|---|
| 13 | W DIY R X:$S($G(DTIME):DTIME,1:300)
|
|---|
| 14 | I '$T S (DIOUT,DTOUT)=1 W $C(7) K DIVAL S DIVAL(0)=0 Q
|
|---|
| 15 | I X'?.ANP D:DIC(0)["Q" S DISUB=DISUB-1 Q
|
|---|
| 16 | . W $C(7)," ",$$EZBLD^DIALOG(204),! Q
|
|---|
| 17 | I X?1.N.1"."1.N,($L($P(X,"."))>25!($L($P(X,".",2))>24)) D:DIC(0)["Q" S DISUB=DISUB-1 Q
|
|---|
| 18 | . W $C(7)," ",$$EZBLD^DIALOG(208),! Q
|
|---|
| 19 | I X="^"!($E(X)="^"&(DISUB>1)) S (DIOUT,DUOUT)=1 K DIVAL S DIVAL(0)=0,DIVAL(1)="^" Q
|
|---|
| 20 | I $L(X)>250 D:DIC(0)["Q" S DISUB=DISUB-1 Q
|
|---|
| 21 | . W $C(7)," ",$$EZBLD^DIALOG(209),! Q
|
|---|
| 22 | I X?1."?" K DIVAL S DIVAL(1)=$E(X,1,2),DIVAL(0)=0,DIOUT=1 Q
|
|---|
| 23 | I (X?1"`".NP)!(X=" ") K DIVAL S DIVAL(1)=X,(DIVAL(0),DIOUT)=1 Q
|
|---|
| 24 | W:DINDEX("#")>1 !
|
|---|
| 25 | S DIVAL(DISUB)=X
|
|---|
| 26 | I X="",$G(DIY(DISUB))]"" S DIVAL(DISUB)=DIY(DISUB) S:DIC(0)'["O" DIC(0)=DIC(0)_"O"
|
|---|
| 27 | Q:DIVAL(DISUB)=""
|
|---|
| 28 | S DIVAL(0)=DIVAL(0)+1
|
|---|
| 29 | S:$E(X)="^" (DIOUT,DUOUT)=1
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | GETPRMT(DIC,DO,DINDEX,DIPRMT) ; Build list of prompts for each lookup value
|
|---|
| 33 | N DICA I $D(DIC("A")) S DICA(1)=$G(DIC("A")) M DICA=DIC("A")
|
|---|
| 34 | N DISUB,I,L,P S L=0
|
|---|
| 35 | F DISUB=1:1:DINDEX("#") D
|
|---|
| 36 | . I $G(DICA(DISUB))]"" D I DIPRMT(DISUB)]""
|
|---|
| 37 | . . S DIPRMT(DISUB)=""
|
|---|
| 38 | . . I DISUB=1,DINDEX("#")>1,DICA(DISUB)="ANOTHER ONE: " Q
|
|---|
| 39 | . . S DIPRMT(DISUB)=DICA(DISUB) Q
|
|---|
| 40 | . E D
|
|---|
| 41 | . . S P=$S(DISUB=1:$P(DO,U),1:"")
|
|---|
| 42 | . . I DISUB=1,$G(DICA(DISUB))="ANOTHER ONE: " S P=$$EZBLD^DIALOG(8050)_P
|
|---|
| 43 | . . I DINDEX("#")=1,D'="B"&(DIC(0)["M")!(D="B"&(DO(2)'>1.9)) S DIPRMT(DISUB)=$$EZBLD^DIALOG(8042,P) Q
|
|---|
| 44 | . . N X S X=DINDEX(DISUB,"PROMPT") I X]"" D
|
|---|
| 45 | . . . I DISUB=1 Q:DINDEX("#")=1&(P[X!(X[P)) S P=P_" "
|
|---|
| 46 | . . . S P=P_X Q
|
|---|
| 47 | . . I DISUB=1 S DIPRMT(DISUB)=$$EZBLD^DIALOG(8042,P)
|
|---|
| 48 | . . E S DIPRMT(DISUB)=P_": "
|
|---|
| 49 | . . Q
|
|---|
| 50 | . S I=$L(DIPRMT(DISUB)) S:I>L L=I Q
|
|---|
| 51 | Q:DINDEX("#")=1
|
|---|
| 52 | S I="",$P(I," ",L)=""
|
|---|
| 53 | F DISUB=1:1:DINDEX("#") S DIPRMT(DISUB)=$E(I,1,(L-$L(DIPRMT(DISUB))))_DIPRMT(DISUB)
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | TRYADD(DIC,DIFILEI) ; Return 1 if user should be allowed to attempt to add record
|
|---|
| 57 | ; when lookup value `ien and .01 is a pointer.
|
|---|
| 58 | Q:DIC(0)'["L" 0
|
|---|
| 59 | N % S %=$P($G(^DD(DIFILEI,.01,0)),U,2)
|
|---|
| 60 | I %["P"!(%["V") Q 1
|
|---|
| 61 | Q 0
|
|---|
| 62 | ;
|
|---|
| 63 | ; Error messages
|
|---|
| 64 | ; 204 The input value contains control characters.
|
|---|
| 65 | ; 208 Input value is an illegal number.
|
|---|
| 66 | ; 209 Input value is too long.
|
|---|
| 67 | ;8042 Select |1|:
|
|---|
| 68 | ;8050 Another
|
|---|
| 69 | ;
|
|---|
