source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DICQ.m@ 1270

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

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
[613]1DICQ ;SFISC/XAK,TKW-HELP FOR LOOKUPS ;7:20 AM 17 May 2007
2 ;;22.0;VA FileMan;**4,3,57,151**;Mar 30, 1999;Build 10
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 S DZ=X D:DIC(0)]"" DQ
5 I '$D(DDS),$G(DDH) D ^DDSU
6 S:$D(DZ) X=DZ K DZ,DDH,DIZ,DDD I $D(DTOUT) S Y=-1 D Q^DIC2 Q
7 D A^DIC Q
8 ;
9DQ ; Main entry point for displaying online ^DIC help (list of current
10 ; entries in a file.
11 N %,%Y,X,Y,DD,DDC,DDD,DS,DID01,DICNT,DIDONE,DIFROM,DIPART,DIW,DIX,DIY,DIZ,DIUPRITE,DST,DIBEGSUB,DIBEGIX
12 I $D(DZ)[0 N DZ S DZ=""
13 S DDC=$S($D(DDS):7,1:15)
14 N:'$D(DDH) DDH S DDH=+$G(DDH)
15 S DIBEGIX=D
16 I '($D(DIRECUR)#2) N DIRECUR S DIRECUR=0
17 I '$D(DO) N DO D GETFA^DIC1(.DIC,.DO)
18 I DO="0^-1" K DO S DST=" Pointed-to File does not exist!" D % Q
19 S DICNT=$P(DO,U,4),DIY=DO D DIY
20 S X=$S($D(^DD(+DO(2),.001,0)):$P(^(0),U,1),DIC(0)["N":"NUMBER",1:""),DIUPRITE=X]""
21 S DIW=^DD(+DO(2),.01,0),DIW=$P(DIW,U,2,3)
22 G:$D(^DD(+DO(2),0,"QUES")) @^("QUES")
23 I DIUPRITE S DS=.001 D DS
24DQ1 I $G(DIFILEI),$G(DINDEX)]"" M DIX=DINDEX
25 E N DIFILEI,DIENS K % M %=DA N DA M DA=% K % D
26 . D GETFILE^DIC0(.DIC,.DIFILEI,.DIENS)
27 . S DIX=$G(D),DIX("WAY")=1 D INDEX^DICUIX(.DIFILEI,"hl",.DIX)
28 . Q
29 S DIBEGSUB=DIX("#")
30 I DIFILEI="" D % Q
31 I $D(DIC("?N",DIFILEI)) S DDC=DIC("?N",DIFILEI)
32 S DIFROM=""
33 N DISAVIX M DISAVIX=DIX
34 D IX K DISAVIX
35 I 'DICNT D 0 Q
36 S DIDONE=0 I DZ'="??" D I DIDONE D 0 Q
37 . D DSPFLD Q:DICNT<11
38 . N DIOUT S DIOUT=0 F D ASKCUR Q:DIOUT
39 . Q
40 D EN^DICQ1
41 Q
42 ;
43IX N DD,DIF,DIFIL,DIFLD,DIFORCE,DIEND,DITMP,I,P,F,X,%
44 S (DD,%)="",DID01=0,DIF="h"_$P("M^",U,DIC(0)["M")
45 S DIFORCE=$S($D(DID):1,1:0),DIFORCE(0)=$S($D(DID):DID,1:"*"),DIFORCE(1)=1
46 F D Q:DIX=""!(DIC(0)'["M")
47 . S DIEND=$S(DIX=DIBEGIX:DIX("#"),1:1)
48 . S (P,DS)="" F I=1:1:DIEND D
49 . . S DIFIL=$G(DIX(I,"FILE")),DIFLD=$G(DIX(I,"FIELD"))
50 . . I DIFIL,DIFLD Q:$D(DITMP(DIFIL,DIFLD)) S DITMP(DIFIL,DIFLD)=""
51 . . I DIX=DIBEGIX D
52 . . . I DIFIL=DIFILEI,DIFLD=.01,DIX("FLISTD")[("^"_.01_"^") S DID01=1
53 . . . S DS=.002 Q
54 . . E S X=DIFLD S:DIFILEI'=DIFIL X=DIFIL_" "_DIFLD S:DS]"" DS=DS_"^" S DS=DS_X
55 . . S X=$G(DIX(I,"PROMPT"))
56 . . I X="",$D(^DD(+DIFIL,+DIFLD,0))#2 S X=$P(^(0),U)
57 . . I I=1 S %=DIX(1,"TYPE")
58 . . Q:X="" I DIX("#")=1,X=$G(DS(.002)) Q
59 . . I $L(X)+$L(P)'>70 S P=P_$P(" & ^",U,P]"")_X Q
60 . . S:P'["..." P=P_"..." Q
61 . I P]"",DS]"" S X=P D DS
62 . I @("$D("_DIC_"DIX))>9!$D(DF)"),DD="" S DD=DIX,DIW=% S:'DICNT DICNT=2 S:'$D(^(DD)) DICNT=0,DIUPRITE=0
63 . I DIC(0)'["M" S DIX="" Q
64 . D NXTINDX^DICF2(.DIX,.DIFORCE,.DIFILEI,DIF,"","*") Q:DIX=""
65 . D INDEX^DICUIX(.DIFILEI,"hql",.DIX) Q
66 K DIX
67 I DIBEGIX=DD M DIX=DISAVIX
68 E S (DIBEGIX,DIX)=DD I DIX]"" S DIX("WAY")=1 D INDEX^DICUIX(.DIFILEI,"hl",.DIX)
69 I DD="" S DIUPRITE=1 I $O(^DD(DIFILEI,0,"IX","AZ"))]""!($O(^DD("IX","BB",DIFILEI,"AZ"))]"") S DICNT=0
70 S:DZ["BAD" DICNT=0
71 Q
72 ;
73DSPFLD ; Display list of lookup fields
74 N X S DST=$$EZBLD^DIALOG(8063,$P(DO,U)),DS=0
75 F X=1:1 S DS=$O(DS(DS)) Q:DS="" D
76 . S:X>1!$G(DS(0)) DST=DST_$$EZBLD^DIALOG(8067)
77 . D:$L(DST)+$L(DS(DS))>70 N S DST=DST_" "_DS(DS) Q
78 K DS S DST=DST_$E(":",DICNT) D %
79 Q
80 ;
81ASKCUR ; Ask if user wants to see existing entries
82 N A1 S DDH=DDH+1,A1=0_U_$$EZBLD^DIALOG(8064)
83 I DO(2)'["s",'$D(DIC("S")),'$D(DIC("V")),'$D(DF),'$D(DIC("?PARAM",DIFILEI)) S A1=A1_$$EZBLD^DIALOG(8065,DICNT)
84 S DDH(DDH,"Q")=A1_$$EZBLD^DIALOG(8066,$P(DO,U))
85 S:$D(DDS) DDD=1 D ^DDSU
86 I '$D(DDS),$D(DTOUT) S (DIOUT,DIDONE)=1 Q
87 I $D(DDS) S %=1 I $D(DDSQ) S (DIOUT,DIDONE)=1 Q
88 ; Process answer to question about seeing existing entries.
89 S A1="T",DDH=+$G(DDH)
90 S:%=1 %Y=1
91 I %Y'="??" D
92 . N F S F=$E(%Y,2,99) I $E(%Y)="^",F]"" S DIFROM=F
93 . S %Y=F Q
94 S:%=2&(DIC(0)["L") DZ=""
95 I (%#2)=0!(%<0&(%Y="")) S (DIOUT,DIDONE)=1 Q
96 I DIFROM="" S DIOUT=1 Q
97 S DIUPRITE=$S(+$P(DIFROM,"E")=DIFROM:1,DIBEGIX]"":0,1:DIUPRITE)
98 I +$P(DIFROM,"E")=DIFROM S DIOUT=1 Q
99 Q:DIBEGIX="" I $P(DIW,U,1)'["D" S DIOUT=1 Q
100 N %DT,Y S X=DIFROM,%DT="T" D ^%DT S DIFROM=Y,DIUPRITE=0
101 I DIFROM<0 S DST=$C(7) D % Q
102 S DIOUT=1 Q
103 ;
104DSPHLP(DIC,DIFILE,DINDEX,DZ,DINOKILL) ; Display online help for lookups (^DIC)
105 N D S D=DINDEX
106 I $D(DIBTDH) K DIBTDH Q
107 S:$D(DDSXEC) DIBTDH=1 ; Set only if there is eXecutable Help to prevent repeated '??' display from AST^DIEQ
108 I DIC(0)]"" D DQ Q:$G(DINOKILL)
109 I '$D(DDS),$G(DDH) D ^DDSU
110 I $D(DTOUT) S Y=-1 D Q^DIC2 Q
111 D A^DIC Q
112 ;
113N D % S DST=" " Q
114 ;
115% ;CALLED FROM ^DICQ1
116 S DDH=$G(DDH)+1,DDH(DDH,"T")=DST K DST Q
117 ;
1180 Q:$D(DTOUT)!(DIC(0)'["L") K DIW,DIUPRITE S:$D(DDS) DDD=1 D 0^DICQ1 Q
119 ;
120DIY S DIY=$P(^DD(+$P(DIY,U,2),.01,0),"$L(X)>",2),DIY=$S(DIY:DIY,1:30)+7 Q
121 ;
122SOUNDEX G DQ1
123 ;
124DS S:DO'[X DS(DS)=X I DO[X,$G(DZ)'["??" S DS(0)=1
125 Q
126 ;
127 ;
128 ;
129 ;#8063 Answer with |Filename|
130 ;#8064 Do you want the entire
131 ;#8065 |Number of entries| Entry
132 ;#8066 |Filename| List
133 ;#8067 , or
134 ;#8068 Choose from ; couldn't find a reference SO 8/11/00
Note: See TracBrowser for help on using the repository browser.