source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIC11.m@ 1674

Last change on this file since 1674 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 2.6 KB
Line 
1DIC11 ;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.
4PROMPT 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 ;
11PR1 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 ;
32GETPRMT(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 ;
56TRYADD(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 ;
Note: See TracBrowser for help on using the repository browser.