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

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

initial load of WorldVistAEHR
File size: 6.0 KB
Line 
1DICQ1 ;SFISC/GFT,TKW-HELP FOR LOOKUPS ;7/18/00 08:14
2 ;;22.0;VA FileMan;**4,3,54**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4EN ; Set up parameters for lister call, then display current entries.
5 I 'DIRECUR,'$D(DDS) D Z^DDSU
6 I DICNT>1,$D(DZ)#2 S DST=" " D:DZ["??"&'$D(DDS) %^DICQ S DST=$$EZBLD^DIALOG(8068) D %^DICQ
7 N DISCR S:$G(DIC("S"))]"" DISCR("S")=DIC("S")
8 I $D(DIC("V")) M DISCR("V")=DIC("V")
9 S %=$G(DIC("?PARAM",DIFILEI,"INDEX")) I %]"" D
10 . S (DIX,DIBEGIX)=%,DIX("WAY")=1 D INDEX^DICUIX(.DIFILEI,"hl",.DIX) Q
11 I $O(DIC("?PARAM",DIFILEI,"PART",0)) S DIPART(1)="",%=0 D
12 . F S %=$O(DIC("?PARAM",DIFILEI,"PART",%)) Q:'% I '(%#1) S DIPART(%)=DIC("?PARAM",DIFILEI,"PART",%)
13 . S DIPART=DIPART(1) Q
14 N DIFLAGS,DIFIELDS,DIIENS S DIFLAGS="MPh"
15 I 'DIUPRITE,"PV"[$G(DIX(1,"TYPE")) D
16 . N DIFRPRT S DIFRPRT=DIFROM_$G(DIC("?PARAM",DIFILEI,"FROM",1))_$G(DIPART)
17 . Q:'$$CHKP^DICUIX1(.DIFILEI,.DIX,DDC,DIFRPRT,.DISCR,1)
18 . S DIFLAGS="MPQh" K DIFROM S DIFROM="" Q
19 I DIUPRITE S DID01=0,DIBEGIX="#"
20 S DIIENS=$S(DIC(0)["p":",",1:DIENS)
21 S DIFIELDS="@;IX" D
22 . I 'DIUPRITE,DID01!(DIC(0)["S") K DID01 Q
23 . S DIC("DID01")="W "" "",$$EXT^DIC2("_DIFILEI_",.01,$P("_DIC_"Y,0),U))"
24 . Q
25E1 K DDD S DD="",DIY=99,DDD=$S($D(DDS):1,1:5),(DIZ,DILN)=21
26 I $D(DDH)>10 D LIST^DDSU Q:$D(DDSQ)
27 I DIFROM]"" D S DIFROM(1)=DIFROM
28 . I +$P(DIFROM,"E")=DIFROM S DIFROM=DIFROM-.00000001 Q
29 . N M F %=$L(DIFROM):-1:1 S M=$A(DIFROM,%) I M>32 S DIFROM=$E(DIFROM,1,%-1)_$C(M-1)_$C(122) Q
30 . Q
31 I DIFLAGS'["Q" S %=$G(DIC("?PARAM",DIFILEI,"FROM",1)) I %]"" D
32 . S:DIFROM="" (DIFROM,DIFROM(1))=% S %=1
33 . F S %=$O(DIC("?PARAM",DIFILEI,"FROM",%)) Q:'% I '(%#1) S DIFROM(%)=DIC("?PARAM",DIFILEI,"FROM",%)
34 . Q
35 ;
36L ; List current entries in the file.
37 N DICQ
38 D LIST^DICL(.DIFILEI,DIIENS,DIFIELDS,DIFLAGS,DDC,.DIFROM,.DIPART,DIBEGIX,.DISCR,"","DICQ","",.DIC)
39 K DIC("DID01"),DICQ
40 D BK^DIEQ S:'$D(DDS) DDD=3 D LIST^DDSU K DDH Q:$D(DDSQ)!($G(DTOUT))
41 D 0 Q
42 ;
43DSP(DINDEX,DICQ,DIC,DIFILE) ; Display entries from DICQ array
44 ; note: this routine is called from the lister, DICLIX & DICL1.
45 N I,J,F,X,Y,DD,DDD,DIY,DILN,DIZ,DIMAP,DDH,DID01,DIQUIET,DIPGM,DST,DISPACE,DIERR,DP
46 S DIMAP=$G(DICQ(0,"MAP")),DDH=0,DST="",DIPGM="DICQ1",$P(DISPACE," ",10)=""
47 S:$G(DIC("DID01"))]"" DID01=DIC("DID01")
48 N DIKEYL,DIKEY I $O(DIFILE(DIFILE,"KEY",DIFILE,0)),DIC(0)'["S" M DIKEYL=DIFILE(DIFILE,"KEY",DIFILE)
49 I $D(DIC("W"))!($D(DID01))!($D(DIKEYL)) D ID
50 F I=0:0 S I=$O(DICQ(I)) Q:'I S X=$G(DICQ(I,0)) I X]"" D
51 . S DST=""
52 . I DINDEX="#" S DST=$P(X,U)_" " S:$L(DST)<7 DST=DST_$E(DISPACE,($L(DST)+1),7)
53 . I $D(DIKEYL) S DIKEY(+X)="" F J=0:0 S J=$O(DIKEYL(J)) Q:'J!$G(DIERR) F F=0:0 S F=$O(DIKEYL(J,F)) Q:'F!$G(DIERR) D
54 . . I (F=.01&($D(DID01))!(DINDEX("FLISTD")[("^"_F_"^"))) D Q
55 . . . S:DIKEY(+X)="" DIKEY(+X)=" " Q
56 . . S Y=$$GET1^DIQ(DIFILE,+X_DIFILE(DIFILE,"KEY","IEN"),F,"","","DIERR") Q:$G(DIERR)
57 . . I ($L(DIKEY(+X)))+($L(Y))+2>240 S DIERR=1 Q
58 . . S DIKEY(+X)=DIKEY(+X)_$P(" ^",U,DIKEY(+X)]"")_Y Q
59 . F J=2:1 Q:$P(DIMAP,U,J)="" S Y=$P(X,U,J) D:$P(DIMAP,U,J+1)]"" S:$L(DST_Y)<240 DST=DST_Y
60 . . S Y=Y_" "
61 . . I J=(DINDEX("#")+1) S Y=Y_" "
62 . . Q
63 . I DST]"" S Y=+X,DDH=DDH+1,DDH(DDH,Y)=DST_" "
64 . Q
65 S DD="",DIY=99,DDD=5,DP=DIFILE
66 I '$G(DIC("?N",DIFILE)) S (DIZ,DILN)=21
67 E S (DIZ,DILN)=999
68 D LIST^DDSU K DICQ
69 K DIERR,^TMP("DIERR",$J)
70 Q
71 ;
72ID ; Put code to display .01 field and Identifiers into DDH array.
73 S DIY="I $D("_DIC_"Y,0))" I $D(DID01) S DIY=DIY_" "_DID01_" "_DIY
74 I $D(DIKEYL) S:$D(DID01) DIY=DIY_" W "" """ S DIY=DIY_" W DIKEY(Y)"
75 I '$D(DIC("W")) S DDH("ID")=DIY Q
76 S DIY=DIY_" "
77 I $L(DIC("W"))+$L(DIY)<240 S DDH("ID")=DIY_DIC("W") Q
78 S DDH("ID")=DIY_"X DDH(""ID"",1)" S DDH("ID",1)=DIC("W") Q
79 ;
80WOV N DIC,Y,DI1X,DIY,DIYX,%,C,DINAME S DIC=DIGBL,Y=DIEN,DI1X=0
81W1 F S DI1X=$O(^DD(DIFILEI,0,"ID",DI1X)) Q:DI1X="" S %=^(DI1X) D
82 . X "W "" "",$E("_DIGBL_DIEN_",0),0)",%
83 Q
84 ;
850 ; If LAYGO allowed, display additional help.
86 K DDC,DIEQ,DIW,DS I DIC(0)'["L" D QQ Q
87 I $D(%Y)#2 S:%Y="??" DZ=%Y S:%Y?1P DZ="?"
88 S DDH=+$G(DDH) N A1,DIACCESS S DIACCESS=1
89 I $S($D(DLAYGO):DIFILEI-DLAYGO\1,1:1),DUZ(0)'="@",'$D(^DD(DIFILEI,0,"UP")) D CHKACC
90 I '$G(DIACCESS) D RCR Q
9110 ; Tell user that they may enter new entries to the file
92 I DZ?1."?" S DST=" " D DS^DIEQ S DST=$$EZBLD^DIALOG(8069,$P(DO,U)) D DS^DIEQ D:DZ="?" HP
93 D H
94 I DO(2)["S" S DST=$$EZBLD^DIALOG(8068)_" " D %^DICQ D
95 . N X,Y,A2,DST,DISETOC,DIMAXL S DIMAXL=0,DISETOC=$P(^DD(+DO(2),.01,0),U,3)
96 . F X=1:1 S Y=$P($P(DISETOC,";",X),":") Q:Y="" S:$L(Y)>DIMAXL DIMAXL=$L(Y)
97 . S DIMAXL=DIMAXL+4
98 . F X=1:1 S Y=$P(DISETOC,";",X) Q:Y="" S A2="",$P(A2," ",DIMAXL-$L($P(Y,":")))=" ",DST=" "_$P(Y,":")_A2_$P(Y,":",2) D DS^DIEQ
99 . Q
100 I DO(2)["V" D
101 . N DG,DU,D
102 . S DU=+DO(2),D=.01 D V^DIEQ Q
103 ;
104RCR ; Recursive call to display entries on pointed-to file.
105 I DO(2)'["P"!($G(DZ(1))=0) D QQ Q
106 N %,D,DS,DIPTRIX S D=""
107 S DS=^DD(+DO(2),.01,0)
108 S DIPTRIX=$G(DIC("PTRIX",+DO(2),.01,+$P($P(DS,U,2),"P",2)))
109 M %=DIC("PTRIX"),%(1)=DIC("?N"),%(2)=DIC("?PARAM")
110 N DIC M DIC("PTRIX")=%,DIC("?N")=%(1),DIC("?PARAM")=%(2) K %
111 S DIC=U_$P(DS,U,3),DIC(0)=$E("L",$P(DS,U,2)'["'")
112 I $P(DS,U,2)["*" D
113 . N DILCV,DICP,DIPTRIX,DISAV0 S DISAV0=DIC(0)
114 . F DILCV=" D ^DIC"," D IX^DIC"," D MIX^DIC1" S DICP=$F(DS,DILCV) I DICP D S DIC(0)=DISAV0
115 . . X $P($E(DS,1,DICP-$L(DILCV)-1),U,5,99) Q
116 . S D=$P($G(D),U) Q
117 S:DIPTRIX]"" D=$P(DIPTRIX,U) K DIPTRIX,DS
118 N DO,DIFILEI,DINDEX I D="" S D="B"
119 S DIRECUR=DIRECUR+1
120 D DQ^DICQ
121QQ Q:$D(DDH)'>10
122 K DDD S DD="",DIY=99,DDD=$S($D(DDS):1,1:5),(DIZ,DILN)=21
123 S:$D(DDS) DDC=-1 D LIST^DDSU K DDC Q
124 ;
125HP N DG,X,%,DST
126 F DG=3,12 I $D(^DD(+DO(2),.01,DG)) S X=^(DG) F %=$L(X," "):-1:1 I $L($P(X," ",1,%))<70 S DST=$P(X," ",1,%) D DS^DIEQ,P1 Q
127 Q
128 ;
129P1 I %'=$L(X," ") S DST=$P(X," ",%+1,99) D DS^DIEQ
130 Q
131 ;
132H ; Display eXecutable help and long description for .01 field.
133 N %,X,DIPGM S %=DIC,X=DZ,DIPGM="DICQ1" D
134 . N DIC,D,DP,DIFILEI,DINDEX,DZ S DZ=X
135 . S DIC=%,D=.01,DP=+DO(2) D H^DIEQ Q
136 Q
137 ;
138CHKACC ;Check file access
139 N A1,DIFILE,DIAC,% S DIFILE=+DO(2),DIAC="LAYGO",%=0 D ^DIAC
140 S:% DIACCESS=1 Q
141 ;
142 ;#8069 You may enter a new |filename|, if you wish
143 ;#8068 Choose from
Note: See TracBrowser for help on using the repository browser.