135 lines
4.7 KiB
Mathematica
135 lines
4.7 KiB
Mathematica
DICQ ;SFISC/XAK,TKW-HELP FOR LOOKUPS ;7:20 AM 17 May 2007
|
|
;;22.0;VA FileMan;**4,3,57,151**;Mar 30, 1999;Build 10
|
|
;Per VHA Directive 2004-038, this routine should not be modified.
|
|
S DZ=X D:DIC(0)]"" DQ
|
|
I '$D(DDS),$G(DDH) D ^DDSU
|
|
S:$D(DZ) X=DZ K DZ,DDH,DIZ,DDD I $D(DTOUT) S Y=-1 D Q^DIC2 Q
|
|
D A^DIC Q
|
|
;
|
|
DQ ; Main entry point for displaying online ^DIC help (list of current
|
|
; entries in a file.
|
|
N %,%Y,X,Y,DD,DDC,DDD,DS,DID01,DICNT,DIDONE,DIFROM,DIPART,DIW,DIX,DIY,DIZ,DIUPRITE,DST,DIBEGSUB,DIBEGIX
|
|
I $D(DZ)[0 N DZ S DZ=""
|
|
S DDC=$S($D(DDS):7,1:15)
|
|
N:'$D(DDH) DDH S DDH=+$G(DDH)
|
|
S DIBEGIX=D
|
|
I '($D(DIRECUR)#2) N DIRECUR S DIRECUR=0
|
|
I '$D(DO) N DO D GETFA^DIC1(.DIC,.DO)
|
|
I DO="0^-1" K DO S DST=" Pointed-to File does not exist!" D % Q
|
|
S DICNT=$P(DO,U,4),DIY=DO D DIY
|
|
S X=$S($D(^DD(+DO(2),.001,0)):$P(^(0),U,1),DIC(0)["N":"NUMBER",1:""),DIUPRITE=X]""
|
|
S DIW=^DD(+DO(2),.01,0),DIW=$P(DIW,U,2,3)
|
|
G:$D(^DD(+DO(2),0,"QUES")) @^("QUES")
|
|
I DIUPRITE S DS=.001 D DS
|
|
DQ1 I $G(DIFILEI),$G(DINDEX)]"" M DIX=DINDEX
|
|
E N DIFILEI,DIENS K % M %=DA N DA M DA=% K % D
|
|
. D GETFILE^DIC0(.DIC,.DIFILEI,.DIENS)
|
|
. S DIX=$G(D),DIX("WAY")=1 D INDEX^DICUIX(.DIFILEI,"hl",.DIX)
|
|
. Q
|
|
S DIBEGSUB=DIX("#")
|
|
I DIFILEI="" D % Q
|
|
I $D(DIC("?N",DIFILEI)) S DDC=DIC("?N",DIFILEI)
|
|
S DIFROM=""
|
|
N DISAVIX M DISAVIX=DIX
|
|
D IX K DISAVIX
|
|
I 'DICNT D 0 Q
|
|
S DIDONE=0 I DZ'="??" D I DIDONE D 0 Q
|
|
. D DSPFLD Q:DICNT<11
|
|
. N DIOUT S DIOUT=0 F D ASKCUR Q:DIOUT
|
|
. Q
|
|
D EN^DICQ1
|
|
Q
|
|
;
|
|
IX N DD,DIF,DIFIL,DIFLD,DIFORCE,DIEND,DITMP,I,P,F,X,%
|
|
S (DD,%)="",DID01=0,DIF="h"_$P("M^",U,DIC(0)["M")
|
|
S DIFORCE=$S($D(DID):1,1:0),DIFORCE(0)=$S($D(DID):DID,1:"*"),DIFORCE(1)=1
|
|
F D Q:DIX=""!(DIC(0)'["M")
|
|
. S DIEND=$S(DIX=DIBEGIX:DIX("#"),1:1)
|
|
. S (P,DS)="" F I=1:1:DIEND D
|
|
. . S DIFIL=$G(DIX(I,"FILE")),DIFLD=$G(DIX(I,"FIELD"))
|
|
. . I DIFIL,DIFLD Q:$D(DITMP(DIFIL,DIFLD)) S DITMP(DIFIL,DIFLD)=""
|
|
. . I DIX=DIBEGIX D
|
|
. . . I DIFIL=DIFILEI,DIFLD=.01,DIX("FLISTD")[("^"_.01_"^") S DID01=1
|
|
. . . S DS=.002 Q
|
|
. . E S X=DIFLD S:DIFILEI'=DIFIL X=DIFIL_" "_DIFLD S:DS]"" DS=DS_"^" S DS=DS_X
|
|
. . S X=$G(DIX(I,"PROMPT"))
|
|
. . I X="",$D(^DD(+DIFIL,+DIFLD,0))#2 S X=$P(^(0),U)
|
|
. . I I=1 S %=DIX(1,"TYPE")
|
|
. . Q:X="" I DIX("#")=1,X=$G(DS(.002)) Q
|
|
. . I $L(X)+$L(P)'>70 S P=P_$P(" & ^",U,P]"")_X Q
|
|
. . S:P'["..." P=P_"..." Q
|
|
. I P]"",DS]"" S X=P D DS
|
|
. I @("$D("_DIC_"DIX))>9!$D(DF)"),DD="" S DD=DIX,DIW=% S:'DICNT DICNT=2 S:'$D(^(DD)) DICNT=0,DIUPRITE=0
|
|
. I DIC(0)'["M" S DIX="" Q
|
|
. D NXTINDX^DICF2(.DIX,.DIFORCE,.DIFILEI,DIF,"","*") Q:DIX=""
|
|
. D INDEX^DICUIX(.DIFILEI,"hql",.DIX) Q
|
|
K DIX
|
|
I DIBEGIX=DD M DIX=DISAVIX
|
|
E S (DIBEGIX,DIX)=DD I DIX]"" S DIX("WAY")=1 D INDEX^DICUIX(.DIFILEI,"hl",.DIX)
|
|
I DD="" S DIUPRITE=1 I $O(^DD(DIFILEI,0,"IX","AZ"))]""!($O(^DD("IX","BB",DIFILEI,"AZ"))]"") S DICNT=0
|
|
S:DZ["BAD" DICNT=0
|
|
Q
|
|
;
|
|
DSPFLD ; Display list of lookup fields
|
|
N X S DST=$$EZBLD^DIALOG(8063,$P(DO,U)),DS=0
|
|
F X=1:1 S DS=$O(DS(DS)) Q:DS="" D
|
|
. S:X>1!$G(DS(0)) DST=DST_$$EZBLD^DIALOG(8067)
|
|
. D:$L(DST)+$L(DS(DS))>70 N S DST=DST_" "_DS(DS) Q
|
|
K DS S DST=DST_$E(":",DICNT) D %
|
|
Q
|
|
;
|
|
ASKCUR ; Ask if user wants to see existing entries
|
|
N A1 S DDH=DDH+1,A1=0_U_$$EZBLD^DIALOG(8064)
|
|
I DO(2)'["s",'$D(DIC("S")),'$D(DIC("V")),'$D(DF),'$D(DIC("?PARAM",DIFILEI)) S A1=A1_$$EZBLD^DIALOG(8065,DICNT)
|
|
S DDH(DDH,"Q")=A1_$$EZBLD^DIALOG(8066,$P(DO,U))
|
|
S:$D(DDS) DDD=1 D ^DDSU
|
|
I '$D(DDS),$D(DTOUT) S (DIOUT,DIDONE)=1 Q
|
|
I $D(DDS) S %=1 I $D(DDSQ) S (DIOUT,DIDONE)=1 Q
|
|
; Process answer to question about seeing existing entries.
|
|
S A1="T",DDH=+$G(DDH)
|
|
S:%=1 %Y=1
|
|
I %Y'="??" D
|
|
. N F S F=$E(%Y,2,99) I $E(%Y)="^",F]"" S DIFROM=F
|
|
. S %Y=F Q
|
|
S:%=2&(DIC(0)["L") DZ=""
|
|
I (%#2)=0!(%<0&(%Y="")) S (DIOUT,DIDONE)=1 Q
|
|
I DIFROM="" S DIOUT=1 Q
|
|
S DIUPRITE=$S(+$P(DIFROM,"E")=DIFROM:1,DIBEGIX]"":0,1:DIUPRITE)
|
|
I +$P(DIFROM,"E")=DIFROM S DIOUT=1 Q
|
|
Q:DIBEGIX="" I $P(DIW,U,1)'["D" S DIOUT=1 Q
|
|
N %DT,Y S X=DIFROM,%DT="T" D ^%DT S DIFROM=Y,DIUPRITE=0
|
|
I DIFROM<0 S DST=$C(7) D % Q
|
|
S DIOUT=1 Q
|
|
;
|
|
DSPHLP(DIC,DIFILE,DINDEX,DZ,DINOKILL) ; Display online help for lookups (^DIC)
|
|
N D S D=DINDEX
|
|
I $D(DIBTDH) K DIBTDH Q
|
|
S:$D(DDSXEC) DIBTDH=1 ; Set only if there is eXecutable Help to prevent repeated '??' display from AST^DIEQ
|
|
I DIC(0)]"" D DQ Q:$G(DINOKILL)
|
|
I '$D(DDS),$G(DDH) D ^DDSU
|
|
I $D(DTOUT) S Y=-1 D Q^DIC2 Q
|
|
D A^DIC Q
|
|
;
|
|
N D % S DST=" " Q
|
|
;
|
|
% ;CALLED FROM ^DICQ1
|
|
S DDH=$G(DDH)+1,DDH(DDH,"T")=DST K DST Q
|
|
;
|
|
0 Q:$D(DTOUT)!(DIC(0)'["L") K DIW,DIUPRITE S:$D(DDS) DDD=1 D 0^DICQ1 Q
|
|
;
|
|
DIY S DIY=$P(^DD(+$P(DIY,U,2),.01,0),"$L(X)>",2),DIY=$S(DIY:DIY,1:30)+7 Q
|
|
;
|
|
SOUNDEX G DQ1
|
|
;
|
|
DS S:DO'[X DS(DS)=X I DO[X,$G(DZ)'["??" S DS(0)=1
|
|
Q
|
|
;
|
|
;
|
|
;
|
|
;#8063 Answer with |Filename|
|
|
;#8064 Do you want the entire
|
|
;#8065 |Number of entries| Entry
|
|
;#8066 |Filename| List
|
|
;#8067 , or
|
|
;#8068 Choose from ; couldn't find a reference SO 8/11/00
|