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

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

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1DIR ;SFISC/XAK-READER, HELP ;11:03 AM 24 Feb 2000
2 ;;22.0;VA FileMan;**30**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 N %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%N,%P,%S,%T,%W,%X,%Y,A0,C,D,DD,DDH,DDQ,DDSV,DG,DH,DIC,DIFLD,DIRO,DO,DP,DQ,DU,DZ,X1,XQH,DIX,DIY,DISYS,%BU,%J1,%A0,%W0,%D1,%D2,%DT,%K,%M
5 S:$D(DDH)[0 DDH=0 Q:'$D(DIR(0)) D ^DIR2 G Q:%T=""
6 I $D(DIR("V"))#2 D ^DIR1 S DDER=%E G Q
7A I $D(DDM) K:DDM DDQ S:'DDM DDQ=IOSL-7
8 I $G(DDH) D LIST^DDSU
9 D W:%A'["V" I $D(DDS),$D(DIR0) S DDACT=Y I DDO=.5 S DDM=1 G Q
10 I %A'["V",%E D QUES S A0="" D MSG D:$G(DDH) LIST^DDSU G A
11 I $D(DTOUT) K Y S DIRUT=1,Y="" G Q
12 I %T'="E",X?1."^".E K Y S (DUOUT,DIRUT)=1,Y=X S:X="^^" DIROUT=1 S:%T="Y" %=-1 G Q
13 I %T'="E","@"[X,%A["O" S Y="",DIRUT=1 S:%T="P" Y=-1 G Q
14 I %A'["O","@"[X,%T'="E" S A0=$C(7)_%A0 D MSG G A
15 I $D(DDS),$D(DIR0),DIR0N G Q
16 I $D(%G),$D(DIR("B")),X=DIR("B") S Y=%G G Q
17 I X'?1."?" K DDQ D ^DIR1 I '%E,$P(DIR(0),U,3)]"" S %X=X D S:'$D(X) %E=1 S X=%X
18 . N %A,%B,%B1,%B2,%B3,%E,%N,%P,%T,%X,%W,%W0
19 . X $P(DIR(0),U,3,99)
20 I %A["V" K:%E Y G Q
21 I X?1."?"!%E D QUES:%E'<0 S A0="" D MSG D:$G(DDH) LIST^DDSU G A
22 G Q
23 ;
24W ; write the prompt and read the user's response
25 S %W=%W0,%N=$E(%W)=U
26 K DTOUT,DUOUT,DIRUT,DIROUT S %E=0 I $D(DDS),$D(DIR0) D ^DIR0 Q
27 I %T="S",%A'["A",%A'["B" D S
28 I $D(DIR("A"))=11 F %=0:0 S %=$O(DIR("A",%)) Q:%'>0 W !,DIR("A",%)
29 W ! W:$L(%P) %P
30 I $L($G(DIR("B")))>19,%A'["r",%T'="D",$D(DIR("B")),$L(DIR("B"))>19,%T'="S",(%B'["D"&%T)!'%T W DIR("B") S Y=DIR("B") D RW^DIR2 S:X="" X=DIR("B") Q
31 W:$D(DIR("B")) DIR("B")_"// "
32 R X:$S($D(DIR("T")):DIR("T"),'$D(DTIME):300,1:DTIME) I '$T S DTOUT=1
33 I $D(DIR("PRE")) X DIR("PRE") I '$D(X) S %E=1,X="" Q
34 I X="",$D(DIR("B")) S X=DIR("B") I %T'="D",%B'["D"&%T W X
35 I X'?.ANP S X="?"
36 Q
37 ;
38QU I %E!(X="?")!($O(^DD(%B1,%B2,21,0))'>0) K %Y S A0="" D MSG F %C=3,12 I $D(^DD(%B1,%B2,%C)) S X1=^(%C),%J=75,%Y=1 D W1
39 I $D(^DD(%B1,%B2,4)) S A0=^(4),A0(0)=1 D MSG
40 I X?1"??".E D
41 . I $D(DDS) N DDC,DDSQ S DDC=7
42 . S A0="" D MSG S %C=0
43 . F S %C=$O(^DD(%B1,%B2,21,%C)) Q:'%C!$D(DDSQ) S A0=^(%C,0) D
44 .. I $D(DDS),$G(DDH),'(DDH#DDC) D LIST^DDSU Q:$D(DDSQ)
45 .. D MSG
46 I %B["P" K DO S DIC=U_$P(%B3,U,3),DIC(0)="M"_$E("L",%B'["'") D AST:%B["*",DQ
47 I %B["D" S %DT=$P($P($P(%B3,U,5,99),"%DT=""",2),"""",1) D HELP^%DTC
48 I %B["S" X:$D(^DD(%B1,%B2,12.1)) ^(12.1) S A0=$$EZBLD^DIALOG(8068)_" " D MSG F %C=1:1 S Y=$P($P(%B3,U,3),";",%C) Q:Y="" S %I=$P(Y,":",2),Y=$P(Y,":") I 1 X:$D(DIC("S")) DIC("S") I S A0=Y_$E(" ",$L(Y)+1,999)_%I D MSG
49 I %B["V" S A0="" D MSG S X1=X,DU=%B1,D=%B2,DZ=X D V^DIEQ S X=X1
50 Q
51DQ N %W S:$D(D)[0 D="B" S (X1,DZ)=X D DQ^DICQ S DDSV=DIC K DD,% S:$D(X1) X=X1
52 Q
53AST F %=" D ^DIC"," D IX^DIC"," D MIX^DIC1" S Y=$F(%B3,%),%=$L(%)+1 Q:Y
54 Q:'Y
55 I $D(DDS) S A0=" " D MSG
56 X $P($E(%B3,1,Y-%),U,5,99)
57 Q
58QUES ;
59 I %T D QU
60 I X="??",$D(DIR("??")) D:$P(DIR("??"),U)]"" HF S:$P(DIR("??"),U,2)]"" A0(0)=1,A0=$P(DIR("??"),U,2,99) D:$P(DIR("??"),U,2)]"" MSG Q
61 I X="??",%T="D" D Q
62 . N DIHELP,DIJUNK,DILINE,DIROOT
63 . D DT^DILF(%DT,"?",.DIJUNK,"","DIROOT")
64 . S A0="" D MSG
65 . F DILINE=1:1:DIHELP S A0=DIROOT("DIHELP",DILINE) D MSG
66 I %T="P" S DIC=%B1,DIC(0)=%B2 S:$D(DIR("S"))#2 DIC("S")=DIR("S") D DQ K DIC("S")
67 I '%N S A0="" D MSG
68 I X'["?" W $C(7)
69 I %N S A0(0)=1,A0=$E(%W,2,999) D MSG
70 D:'%N WRAP:%W]"" I %T["S",(%A["A"!(%A["B")) D S
71 Q
72WRAP I $D(DIR("?"))=11 F %I=1:1 Q:'$D(DIR("?",%I)) S A0=DIR("?",%I) D MSG
73 K %Y S %J=$S($G(IOM,80)>6:$G(IOM,80)-6,IOM>1:IOM,1:2),%Y=1 S X1=$S(($D(DIR("?"))&'%N):DIR("?"),1:%W)
74 I '%N,$D(DIR("?"))'=11,$E(X1,$L(X1))'="." S X1=X1_"."
75W1 I $L(X1)<%J S %Y(%Y)=X1
76 E D G W1
77 . I $E(X1,1,%J-1)'?.E1P.E S %I=%J-1
78 . E F %I=%J-1:-1:1 Q:$E(X1,%I)?1P
79 . S %Y(%Y)=$E(X1,1,%I),X1=$E(X1,%I+1,999),%Y=%Y+1
80 F %I=1:1:%Y S A0=%Y(%I) D MSG
81 I $D(DDS),%T="S" D
82 . S A0="Choose from:" D MSG
83 . F %I=1:1 Q:$P(%B,";",%I,999)="" D
84 .. S %Y=$P(%B,";",%I),Y=$P(%Y,":") Q:Y=""
85 .. I $D(DIR("S"))#2 X DIR("S") E Q
86 .. S A0=Y_$J("",9-$L(Y))_$P(%Y,":",2) D MSG
87 K %Y,%,X1
88 Q
89HF S XQH=$P(DIR("??"),U) N %A,%B,%E,DIR D EN1^XQH
90 Q
91MSG ;
92 I $D(DDS),A0]"" D
93 . S DDH=$G(DDH)+1
94 . I $D(A0)>9 S DDH(DDH,"T")="",DDH=DDH+1,DDH(DDH,"X")=A0
95 . E S DDH(DDH,"T")=A0
96 I '$D(DDS),$D(A0)>9 W:$X ! X A0
97 I '$D(DDS),$D(A0)=1 W !,A0
98 K A0
99 Q
100S W:$G(X)'?1."?"!(%A["A") !
101 I $D(DIR("L"))#2 D
102 . I $D(DIR("L"))=11 F %=0:0 S %=$O(DIR("L",%)) Q:%'>0 W !,DIR("L",%)
103 . W !,DIR("L")
104 E I %B'[":",$O(DIR("C",""))]"" D
105 . W !?5,"Select one of the following:",!
106 . S %I="" F S %I=$O(DIR("C",%I)) Q:%I="" D
107 .. S Y=$P(DIR("C",%I),":")
108 .. I $D(DIR("S"))#2 X DIR("S") E Q
109 .. W !?10,Y,?20,$P(DIR("C",%I),":",2)
110 E D
111 . W !?5,"Select one of the following:",!
112 . F %I=1:1 Q:$P(%B,";",%I,999)="" D
113 .. S Y=$P($P(%B,";",%I),":") Q:'$L($P(%B,";",%I,99))
114 .. I $D(DIR("S"))#2 X DIR("S") E Q
115 .. W !?10,Y,?20,$P($P(%B,";",%I),":",2)
116 W:%A'["A" !
117 Q
118Q G ^DIRQ
119 ;
120 ;#8068 Choose from
Note: See TracBrowser for help on using the repository browser.