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

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1DIEQ ;SFISC/XAK,YJK-HELP DURING INPUT ;09:13 AM 27 Jul 2001
2 ;;22.0;VA FileMan;**4,3,59**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4BN S D=$P(DQ(DQ),U,4) S:DP+1 D=DIFLD
5 S DZ=X D EN1 G B^DIED
6QQ ;
7 I DV,DV["*",$D(^DD(+DV,.01,0)) S DQ(DQ)=$P(DQ(DQ),U,1,4)_U_$P(^(0),U,5,99)
8EN1 S DDH=0 G M:DV I DP<0 D HP G P
9 I X="?"!(X["BAD") F DG=3,12 Q:DG=12&($G(DISORT)) I $D(^DD(DP,D,DG)) S X=^(DG),A1="T" D N
10 D H G:'$D(DZ) Q
11 ;
12P I DV["P" K DO S DIC=U_DU,D="B",DIC(0)="M"_$E("L",DV'["'") G AST:DV["*"&('$G(DISORT)) D DQ^DICQ D %
13VP I DV["V" S DU=DP S:DV DU=+DO(2),D=.01 D V G Q
14D I DV["D" S %(0)=0,%DT=$P($P($P(DQ(DQ),U,5,9),"%DT=""",2),"""",1) D HELP^%DTC
15S I DV["S" X:($D(^DD(DP,D,12.1))#2)&('$G(DISORT)) ^(12.1) S A1="T",DST=$$EZBLD^DIALOG(8068)_" " D DS,S1 K DIC("S")
16Q K DST,A1 S:$D(DIE) DIC=DIE S D=0 I $D(DDH)>10 D LIST^DDSU
17 D:DV UDA
18 Q
19 ;
20 ;
21S1 F DG=1:1 S Y=$P($P(DQ(DQ),U,3),";",DG) Q:Y="" S D=$P(Y,":",2),Y=$P(Y,":",1) X:$D(DIC("S")) DIC("S") I S A2="",$P(A2," ",15-($L(Y)+7))=" ",DST=" "_Y_A2_" "_D D DS
22 K A1,A2 Q
23 ;
24N F Q:X="" F %=$L(X," "):-1:1 I $L($P(X," ",1,%))<75 S DST=$P(X," ",1,%) D DS D:X'="" N1 Q
25 S X=DZ
26 Q
27 ;
28N1 S X=$P(X," ",%+1,$L(X," ")) Q
29 ;
30DS S:'$D(A1) A1="T" S DDH=$G(DDH)+1,DDH(DDH,A1)=$S(A1="X":"",1:" ")_DST K A1,DST Q
31 ;
32HP I $D(DQ(DQ,3)) S A1="T",DST=DQ(DQ,3) D DS
33 I $D(DQ(DQ,4)) S A1="X",DST=DQ(DQ,4) D DS
34 Q
35 ;
36% S %=$G(DIC("V")) K DIC S:%]"" DIC("V")=% Q
37 ;
38AST S:$D(X)[0 X="?" X $P(DQ(DQ),U,5,99) K DIC G Q
39 D ^DIC K DIC,DICS,DICW G Q
40 ;
41M K DO S DZ=X,DIC=DIE_DA_","_$S(+$P(DC,U,3)=$P(DC,U,3):$P(DC,U,3),1:$C(34)_$P(DC,U,3)_$C(34))_",",D="B",DIC(0)="LM",DZ(1)=0
42 I '$D(@(DIC_"0)")) S DO=U_$P(DC,U,2) D DO2^DIC1
43 D:'$D(DO) DO^DIC1
44 D DDA,DQ^DICQ D % G Q:'$D(DZ)!(DV["S") S X=DZ G P
45 ;
46H I '$G(DISORT),$D(^DD(DP,D,4)) S A1="X",DST=^(4) D DS,LIST^DDSU Q:'$D(DZ)!$D(DDSQ)
47 I $G(X)?1"??".E,X'["BAD" D
48 . N DIDG,DG,DDD,DD,DIY,DIZ,DUOUT
49 . S DIDG=$P($G(^DD(DP,D,21,0)),U,3)
50 . K DDSQ
51 . I '$D(DDS) S DDD=5,DD="",DIY=99,DIZ=21 I $G(DIPGM)'="DICQ1" N DIPGM S DIPGM="DIEQ" D Z^DDSU
52 . F DG=1:1 Q:'$D(^DD(DP,D,21,DG,0)) Q:+DIDG&(DG>DIDG) D Q:$D(DDSQ)
53 . . I '($G(DDH)#15) D LIST^DDSU I $G(DTOUT)!($G(DUOUT)) S DDSQ=1
54 . . Q:$D(DDSQ)
55 . . S DST=^DD(DP,D,21,DG,0) D DS Q
56 . I '$D(DDSQ) Q:$D(DDH)'>10 D LIST^DDSU
57 . I $D(DDSQ) K DDSQ,DDH
58 . Q
59 Q
60 ;
61BK S DDH=$G(DDH)+1,DDH(DDH,"T")=" " Q
62 ;
63V S DDH=+$G(DDH),A1="T",DST=$$EZBLD^DIALOG(8071) D DS
64 F Y=0:0 S Y=$O(^DD(DU,D,"V",Y)) Q:Y'>0 I $D(^(Y,0)) S Y(0)=^(0) X:$D(DIC("V")) DIC("V") I I $D(^DIC(+Y(0),0)) S Y(1)=$P(Y(0),U,4),Y(2)=$P(Y(0),U,2),DST=$$EZBLD^DIALOG(8072,.Y) K Y(1),Y(2) D DS
65 D BK S DST=$$EZBLD^DIALOG(8073) D DS S DU="" D BK I DZ'?1"??".E K X,DZ Q
66 D T^DIEQ1 K X,DZ Q
67 ;
68DDA N T,%
69 S T=$T
70 F %=+$O(DA(" "),-1):-1:1 K DA(%+1) S:$D(DA(%))#2 DA(%+1)=DA(%)
71 K DA(1) S:$D(DA)#2 DA(1)=DA
72 I T
73 Q
74 ;
75UDA N T,%
76 S T=$T
77 S DA=$G(DA(1)) ;K DA(1)
78 F %=2:1:+$O(DA(" "),-1) I $D(DA(%))#2 S DA(%-1)=DA(%) K DA(%)
79 I T
80 Q
81 ;
82 ;#8071 Enter one of the following
83 ;#8072 |Prefix|.EntryName to select a |filename|
84 ;#8073 To see the entries in any particular file type <Prefix.?>
Note: See TracBrowser for help on using the repository browser.