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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1DIC2 ;SF/XAK/TKW-LOOKUP (CONT) ;5/10/00 11:16
2 ;;22.0;VA FileMan;**4,17,20,31,40**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4WO ; Display .01 field, Primary KEY values and Identifiers for an entry.
5 I '$D(DST) N DST
6 S DST=$G(DST)_" " D WR
7 I $D(DIC("W")),$D(@(DIC_"Y,0)")) D:$D(DDS)&'$D(DDH("ID")) ID^DICQ1 I '$D(DDS) D
8 . I $G(DST)]"" W DST," "
9 . N DISAVEX M DISAVEX=Y N Y M Y=DISAVEX S DISAVEX=X N X S X=DISAVEX K DISAVEX
10 . I $D(@(DIC_"Y,0)")) X DIC("W")
11 . K DST Q
12 Q
13WR ; Put .01 field into DST for display
14 D:'$D(DO) GETFA^DIC1(.DIC,.DO) I '$D(DST) N DST
15 I (DIC(0)["S"!(DIC(0)["s")),DIVAL(1)'=" " Q:" "[$G(DST)&('$D(DIX("K"))) D S Q
16 S DST=$G(DST)
17 I DO(2)["V",DIY?1.N1";"1.E S DST=DST_$$EXT(+DO(2),.01,DIY) D S Q
18 I DIY?.N.1".".N,(DO(2)["P"!(DO(2)["D")),DIY D D S Q
19 . I DO(2)["P" S DST=DST_$$EXT(+DO(2),.01,DIY) Q
20 . N % S %=DIY D DT^DIC1 Q
21W1 I '$G(DIYX),DIY]"",((DST'[DIY)!($P(DST,DIY)]"")) S DST=DST_DIY
22S ; Put Primary KEY values into DST, display DST if not in ScreenMan
23 I $D(DIX("K")),DIC(0)'["S" N I,F,% F I=0:0 S I=$O(DIX("K",I)) Q:'I F F=0:0 S F=$O(DIX("K",I,F)) Q:'F D
24 . I DIY]"",F=.01 Q
25 . I $G(DIX("F"))[("^"_F_"^") Q
26 . S %=DIX("K",I,F) Q:%="" I $L(%)+$L(DST)>240 Q
27 . S DST=DST_$P(" ^",U,DST]"")_% Q
28 N A1 S A1=Y I '$D(DDS) W DST K DST Q
29H ; Display .01 and Primary KEY values if in ScreenMan
30 I '$D(A1) N A1 S A1="T"
31 S DDH=$G(DDH)+1,DDH(DDH,A1)=DST K DST Q
32 ;
33EXT(DIFILE,DIFIELD,DIVAL,DIF) ; Return external value of field
34 N DIERR,DISAV S DISAV=$G(DIVAL) I DISAV="" Q DISAV
35 S DIF=$G(DIF) S:DIF="" DIF="F"
36 S DIVAL=$$EXTERNAL^DIDU(DIFILE,DIFIELD,DIF,DIVAL,"DIERR")
37 I $D(DIERR) S DIVAL=DISAV
38 Q DIVAL
39 ;
40PGM(DIC,DF,DIFILE) ; Return special lookup program name
41 I DIC(0)["I"!($G(DF)]"") Q ""
42 N DIPGM S DIPGM=$G(^DD(DIFILE,0,"DIC")) Q:DIPGM=""!(DIPGM?1"DI".E) ""
43 Q U_DIPGM
44 ;
45GOT I DIC(0)["E" D
46 . N:'$D(DST) DST N DDH D WO
47 . I $D(DDS),$D(DDH)>10 D LIST^DDSU K DDH("ID")
48 . Q
49 S Y=Y_"^"_$S(DIY="":X,$G(DIYX):X_DIY,1:DIY)
50 I DIC(0)["E" D Q:Y<0
51 . I DO(2)["O"!($G(DIASKOK)) D OK^DIC1 Q
52 . Q:DIC(0)'["T"
53 . I $G(DICR) Q:'$G(DICRS)!(DICR'=1) D OK^DIC1 Q
54 . D OK^DIC1 Q
55R D:'$G(DICR) I Y<0 D A^DIC S DS(0)="1^" Q
56 . D ACT^DICM1 Q:Y<0
57 . Q:DINDEX("#")'>1!(DINDEX("START")'=DINDEX)
58 . N I F I=1:1:DINDEX("#") I $D(DIX(I))#2 S X(I)=DIX(I)
59 . Q
60 I DIC(0)["Z" S Y(0)=@(DIC_"+Y,0)"),Y(0,0)=$$EXT(DIFILEI,.01,$P(Y(0),U))
61ACT I DIC(0)'["F",$D(DUZ)#2 S ^DISV(DUZ,$E(DIC,1,28))=$E(DIC,29,999)_+Y
62 I $D(@(DIC_"+Y,0)")) D:DIC(0)'["T" Q Q
63 S Y=-1 D Q S DS(0)="1^" Q
64 ;
65Q K DIDA,DID,DISMN,DINUM,DS,DF,DD,DIX,DIY,DIYX,DZ,DO,D,DIAC,DIFILE
66 I '$G(DICR) K DIC("W"),DIROUT I DIC(0)["T" K ^TMP($J,"DICSEEN")
67 Q
68 ;
69G ; Display index values for a single looked-up entry
70 I $D(DS(0,"DICRS")),'$D(DICRS) N DICRS S DICRS=1
71 I $D(DS(0,"DIDA")),'$G(DIDA) N DIDA S DIDA=1
72 I $D(DIDA),$P(DS(1),U,2,99)]"" N:'$G(DIASKOK) DIASKOK S DIASKOK=1
73 I DIC(0)["T",DIC(0)["E",'$D(DDS) D DSPH^DIC0 W !
74 S DIY=1,DIX=X I DIC(0)["E",DIC(0)'["U" D
75 . I DIC(0)["D" Q:$P(DS(1,"F"),U,2)=.01 N DIENTIRE S DIENTIRE=1
76 . N D,% S (D,%)=""
77 . I $G(DIDA),$P(DS(1),U,2,99)]"" S %=" partial match to:"
78 . I $O(DS(1,0)) D
79 . . I DINDEX("#")=1,'$G(DIDA) S D=%_$$BLDDSP^DIC1(.DS,1,1,.DIYX,.DIY,$G(DICRS)) Q
80 . . S D=%_$$BLDDSP^DIC1(.DS,1,"","","",$G(DICRS)) Q
81 . E I $G(DITRANX) D
82 . . S D=X_$P(DS(1),U,2,99)_$S($G(DIYX(1)):$G(DIY(1)),1:"")
83 . . I $G(DINDEX(1,"TRANOUT"))]"" N X S X=D X DINDEX(1,"TRANOUT") S D=$G(X)
84 . . S:D]"" D=" "_D I $G(DIFINDER)["p",'$D(DDS) W !
85 . . Q
86 . E I '$D(DICRS) D
87 . . I $G(DIDA) S D=$P(DS(1),U,2,99) I D]"" S D=%_" "_$$FMTE^DILIBF(X_D,"1U") W:'$D(DDS) ! Q
88 . . S D=$P(DS(1),U,2,99)_$S($G(DIYX(1)):$G(DIY(1)),1:"")
89 . . I $G(DIFINDER)["p" S D=X_D W:'$D(DDS)&(DIC(0)'["T") ! Q
90 . . I DIC(0)["T"!($G(DIENTIRE)) S D=X_D
91 . . Q
92 . S DST=$P(" ^",U,$D(DST)#2)_D
93 . I '$D(DDS) W DST S DST=""
94 . Q
95C S Y=$G(DIX) M DIX=DS(DIY) S DIX=Y
96 I $O(DS(1)) K DIX("F")
97 S Y=+DS(DIY),X=X_$P(DS(DIY),"^",2),DIYX=$G(DIYX(DIY)),DIY=DIY(DIY)
98 D GOT Q
99 ;
100 ;
Note: See TracBrowser for help on using the repository browser.