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

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

initial load of WorldVistAEHR

File size: 5.7 KB
RevLine 
[613]1DIC1 ;SFISC/GFT/TKW-READ X, SHOW CHOICES ;8:39 AM 22 Jan 2003
2 ;;22.0;VA FileMan;**1,4,17,20,31,48,78,86,70,122**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 K DUOUT,DTOUT N DD,DIY,DISUB,DIPRMT
5 D GETFA(.DIC,.DO)
6 N DIPRMT D GETPRMT^DIC11(.DIC,.DO,.DINDEX,.DIPRMT)
7B I $D(DIC("B")) D
8 . N B S B(1)=$G(DIC("B")) M B=DIC("B")
9 . N DIGBL,DINONULL S DIGBL=DIC_""""_DINDEX_"""",DINONULL=1
10 . F DISUB=1:1:DINDEX("#") D S:B]"" DIY(DISUB)=B
11 . . S B=$G(B(DISUB)) I B="" S DINONULL=0 Q
12 . . S X="" S:DINONULL X=$O(@(DIGBL_",B)"))
13 . . S B=$S($D(^(B)):B,$F(X,B)-1=$L(B):X,$D(@(DIC_"B,0)")):$P(^(0),U),1:B)
14 . . N B1 S B1=B I "VPD"[DINDEX(DISUB,"TYPE") D
15 . . . I B D Q:$D(DIY(DISUB,"EXT"))
16 . . . . N TYPE S TYPE=DINDEX(DISUB,"TYPE")
17 . . . . I TYPE="D" Q:B'?7N.1".".N
18 . . . . I TYPE="P" Q:B'?.N.1".".N
19 . . . . I TYPE="V" Q:B'?1.N.1".".N1";".E
20 . . . . S DIY(DISUB,"EXT")=$$EXT^DIC2(DINDEX(DISUB,"FILE"),DINDEX(DISUB,"FIELD"),B)
21 . . . . S:TYPE="P" B=DIY(DISUB,"EXT") Q
22 . . . D CHK^DIE(DINDEX(DISUB,"FILE"),DINDEX(DISUB,"FIELD"),"",B,.B1,"DIERROR") S:$G(DIERROR) B1=B
23 . . . K DIERROR,DIERR Q
24 . . S:DINONULL DIGBL=DIGBL_","_$S(+$P(B1,"E")=B1:B1,1:""""_B1_"""")
25 . . Q
26 . Q
27PROMPT ; Prompt user for lookup values
28 D PROMPT^DIC11
29 Q
30 ;
31 ;
32GETFA(DIC,DO) ; Get file attributes
33 ; DIC is open global reference, output same as documented in DO^DIC1.
34 D DO Q
35 ;
36DO ; GET FILE ATTR
37 Q:$D(DO) I $D(@(DIC_"0)")) S DO=^(0)
38 E S DO="0^-1" I $D(DIC("P")) S DO=U_DIC("P"),^(0)=DO
39DO2 S DO(2)=$P(DO,U,2) I DO?1"^".E S DO=$O(^DD(+DO(2),0,"NM",0))_DO
40 I DO(2)["s",$D(^DD(+DO(2),0,"SCR")) S DO("SCR")=^("SCR")
41 Q:$D(DIC("W")) Q:DO(2)'["I" Q:'$D(^DD(+DO(2),0,"ID"))
42 S DIC("W")=""
43P ; Add code to DIC("W") to display identifiers on pointed-to files
44 I DO(2)["P" D WOV,PTRID^DIC5(.DO,.DIC) Q
45 N % S %=0
46 ;
47W F S %=$O(^DD(+DO(2),0,"ID",%)) D:%]"" Q:%=""
48 . N X S X=^DD(+DO(2),0,"ID",%) Q:X="W """""
49 . I $L(DIC("W"))+$L(X)>224 D WOV S %="" Q
50 . I DIC("W")="" S DIC("W")="N C,DINAME"
51 . S DIC("W")=DIC("W")_" W "" "" "_X
52 . Q
53 Q
54 ;
55WOV S DIC("W")="N DIFILEI,DIEN,DIGBL S DIFILEI=+DO(2),DIEN=Y,DIGBL=DIC D WOV^DICQ1"
56 Q
57 ;
58RENUM ;
59 D GETFA(.DIC,.DO)
60 I '$D(DF),X?.NP,^DD(+DO(2),.01,0)["DINUM",$D(@(DIC_"X)")) D Q:Y>0
61 . S Y=X D S^DIC3 I $T N DZ D ADDKEY^DIC3,GOT^DIC2 Q
62 . S Y=-1 Q
63 D F^DIC Q
64 ;
65DT S DST=DST_$$FMTE^DILIBF(%,"7S")
66 I '$D(DDS) W DST S DST=""
67 Q
68 ;
69Y ; Display a list of entries
70 N DD,DDD,DDC,DDH,DIOUT S DIY="",DIOUT=0,DD=DS("DD")
71 I DD=0,DIC(0)["T",DIC(0)["E" D DSPH^DIC0
72 F S DD=$O(DS(DD)) Q:'DD D Q:DIOUT
73 . S DDH=DD-1,DIYX=0,DS("DD")=DD
74 . I DIC(0)["E" W:'$D(DDS) !?5,DD,?9 D
75 . . N Y S Y=+DS(DD)
76 . . D E Q
77 . I DIC(0)["Y" Q:DD<DS D
78 . . F Y=DS:-1 Q:'DS(Y) S Y(+DS(Y))=""
79 . . Q
80 . I DIC(0)'["E"!(DIC(0)["Y") S DS(0)="1^",DIOUT=1,DIY="" Q
81 . I DS>DD Q:DD#5
82 . S DIOUT=1
83 . I $D(DDS) S DDD=2,DDC=5 D LIST^DDSU K DDD,DDC
84 . I '$D(DDS) D
85 . . I DS>DD W !,"Press <RETURN> to see more, '^' to exit this list,"_$S(DIC(0)["T":" '^^' to exit all lists,",1:"")_" OR" ;**122**
86 . . W !,"CHOOSE "_$O(DS(0))_"-"_DD R ": ",DIY:$S($D(DTIME):DTIME,1:300) S:'$T DTOUT=1 Q
87 . I $G(DTOUT) W $C(7) S X="" Q
88 . I DIY[U!($G(DUOUT)) S DUOUT=1,X=U D Q
89 . . I DIY?1"^^".E,DIC(0)["T" S DIROUT=1 Q
90 . . I DIY?1"^".E,DIC(0)["E",DIC(0)'["T" S DIROUT=1 Q
91 . Q
92 I DIY?1.N.1".".N D I DIY,DIY'>DD,$G(DS(DIY)) S Y=+DS(DIY) D GOT S DS(0)=1_"^"_+Y Q
93 . S:($L($P(DIY,"."))>25!($L($P(DIY,".",2))>25)) DIY="-1" Q
94 I $L(DIY)>25 S DIY=-1
95 N I S I=$S($G(DUOUT):"1^U",$G(DTOUT):"1^T",DIY?1."?":"1^?",DIY:1,1:"")
96 I 'I,DIY]"",+$P(DIY,"E")'=DIY,'$G(DICR),DINDEX("#")=1 S I="2^"_DIY
97 Q:'I
98 S DS(0)=I,Y=-1
99 I DIY?1."?" D
100 . I (DIC(0)_$G(DICR(1,0)))'["A",$D(DICRS) Q
101 . N X,Y,DS D DSPHLP^DICQ(.DIC,.DIFILEI,.DINDEX,"?",1)
102 K DIY,DIYX Q
103 ;
104E S DST="" D
105 . Q:DIC(0)["U"
106 . I $O(DS(DD,0)) S DST=$$BLDDSP(.DS,DD) Q
107 . S %=$S($G(DILONGX):DICR(DICR,"ORG"),$G(DINDEX("IXTYPE"))'="S":$P(X,U),1:"")
108 . S %=%_$P(DS(DD),U,2,9)_$S($G(DIYX(DD)):DIY(DD),1:"")
109 . I ($G(DITRANX)!($G(DICRS))),$G(DINDEX(1,"TRANOUT"))]"",%]"" D Q
110 . . N X S X=% X DINDEX(1,"TRANOUT") S DST=$G(X) Q
111 . I +$P(%,"E")=%,$D(DIDA) D DT Q
112 . I $G(DICRS),$G(DINDEX("IXTYPE"))="R" D
113 . . N F1,F2 S F1=$G(DINDEX(1,"FILE")),F2=$G(DINDEX(1,"FIELD"))
114 . . I F1,F2 S %=$$EXT^DIC2(F1,F2,%,"h")
115 . . Q
116 . S DST=% Q
117 I DIC(0)["s" S DIC(0)=$TR(DIC(0),"s")
118 I $D(DS(DD,"K")) S %=$G(DIX) M DIX=DS(DD) S DIX=%
119 S DIY=$S($G(DIYX(DD)):"",1:DIY(DD)) D WO^DIC2 Q
120 ;
121BLDDSP(DS,DD,DINDXFL,DIYX,DIY,DICRS) ; Build display of index values
122 N X,I S X=""
123 F I=0:0 S I=$O(DS(DD,I)) Q:'I D
124 . I $L(X)+$L(DS(DD,I))>240 Q
125 . I I=1,$G(DINDXFL) S X=$P(DS(1),U,2,99)_$S($G(DIYX(1)):$G(DIY(1)),1:"") Q
126 . I I=1,$G(DICRS) Q
127 . S X=X_$P(" ^",U,I>1)_DS(DD,I) Q
128 Q X
129 ;
130GOT ; Set data for single entry selected by user.
131 N I,J,K
132 I DIY(DIY)="" S DIY(DIY)=$P($G(@(DIC_"Y,0)")),U)
133 S:$D(DDS) DST=X_$P(DS(DIY),U,2,9)_$S($G(DIYX(DIY)):$G(DIY(DIY)),1:"")
134 S K=$O(DIVPSEL("A"),-1) I K]"" S DIVPSEL(K)=Y
135 I $G(DIFINDR) D Q
136 . S:$D(DDS) DS(0,"DST")=DST
137 . S DS(0,"Y")=+DS(DIY),DS(0,"X")=X_$P(DS(DIY),"^",2),DS(0,"DIYX")=$G(DIYX(DIY)),DS(0,"DIY")=DIY(DIY)
138 . M DS(0,1)=DS(DIY)
139 . Q
140 I $G(DIYX(DIY)) K DIYX S DIY(DIY)=$P($G(@(DIC_"Y,0)")),U)
141 D C^DIC2 Q
142 ;
143OK ;
144 S %=1 I $G(DS)=1 S DST=" ...OK" D Y^DICN W:'$D(DDS) !
145 I %>0 Q:%=1 D S X=$G(DIX),Y=-1 Q ;%=1=Yes, %=2=No ;22*70
146 . I $G(DICR) S DICR(DICR,31.2)=+Y ;Preserve IEN for future reference
147 . I +$G(DS) K DS S (DS,DS(0),DS("DD"))=0 ;ReInit Display array
148 . Q
149 I %=0 W !?4,$$EZBLD^DIALOG(8040),! G OK ;User asked for Help
150 I %=-1,$D(DTOUT) S DIROUT=1 ;User TIMED Out; DTOUT set in DICN
151 I %=-1,'$D(DTOUT) S (DUOUT,DIROUT)=1 ;User single up-arrowed out
152BAD S Y=-1
153 I $G(%Y)?1"^^".E S (DIROUT,DUOUT)=1
154 S DS(0)=$S($G(DTOUT):"1^T",$G(DUOUT):"1^U",$G(%)=-1:"1^U",1:"1^") Q
155MIX ;
156 N DID S DID=D_"^-1",DID(1)=2
157 N D S D=$P(DID,U)
158 G IX^DIC
159 ;
160 ;#8042 Select |filename|:
161 ;#8040 Answer with 'Yes' or 'No'
Note: See TracBrowser for help on using the repository browser.