Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DICQ

DICQ.m

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