source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIEH.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: 4.5 KB
RevLine 
[613]1DIEH ;SFISC/DPC-HELP ;11/9/94 14:23
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4GET(DIEHF,DIEHIEN,DIEHFLD,DIEHFLG,DIEHOUT) ;
5GETX ;
6 N DIEHZ,DIEHD,DIEHEXIT,DIEHPF,DIEHUFLG
7 S DIEHUFLG=$G(DIEHFLG)
8 I '$G(DIQUIET) N DIQUIET S DIQUIET=1
9 I '$G(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
10 I $G(DIEHIEN)]"" N DA,C,D,I D DA^DIEFU(DIEHIEN,.DA) S C=$L(DIEHIEN,",")-1 F I=1:1:C S D="D"_(C-I) N @D S @D=$P(DIEHIEN,",",I)
11 S DIEHZ=$$ZERO(DIEHF,DIEHFLD) I DIEHZ=0 G GETOUT
12 S DIEHD=$P(DIEHZ,U,2)
13 D BLDFLGS G:$G(DIEHEXIT) GETOUT
14 I DIEHD["P" S DIEHPF=+$P(DIEHD,"P",2)
15 S DIHELP=+$O(^TMP("DIHELP",$J,""),-1)
16 I DIEHUFLG["F",DIEHFLD=.01 D PXREFS(DIEHF,DIEHFLD)
17 I DIEHUFLG["H" D HPROMPT(DIEHF,DIEHFLD)
18 I DIEHUFLG["X" D XHLP(DIEHF,DIEHFLD)
19 I DIEHUFLG["D" D DESCR(DIEHF,DIEHFLD)
20 I DIEHUFLG["P" D SCRNDES(DIEHF,DIEHFLD)
21 I DIEHUFLG["C" D SCRNDES(DIEHF,DIEHFLD)
22 I DIEHUFLG["T" N DIEHDT S DIEHDT=$P($P($P(DIEHZ,U,5,99),"%DT=""",2),"""",1) D DT^DIEH1(DIEHDT)
23 I DIEHUFLG["S" D SCRNCD(DIEHF,DIEHFLD,DIEHZ)
24 I DIEHUFLG["U" D UNSCRNCD(DIEHZ)
25 I DIEHUFLG["V" D VPMSG(DIEHF,DIEHFLD)
26 I DIEHUFLG["B",DIEHUFLG'["b" D BLD^DIALOG(9115)
27 I DIEHUFLG["M" D BLD^DIALOG(9116)
28 I DIEHUFLG["G",DIEHFLG'["g",$G(DIEHPF) D FOLLOW(DIEHPF,DIEHFLG)
29 I '$G(DIHELP) K DIHELP
30GETOUT I $D(DIEHOUT) D CALLOUT^DIEFU(DIEHOUT)
31 Q
32 ;
33BLDFLGS ;
34 N A1,A2,C1,C2,DIEHGFLG
35 S C1="HX",C2="XD",(A1,A2)=""
36 I DIEHD S DIEHF=+DIEHD,DIEHFLD=.01,DIEHD=$P(^DD(DIEHF,.01,0),U,2)
37 I DIEHD["W" S (A1,A2)="HD"
38 E I DIEHD["D" S (A1,A2)="T"
39 E I DIEHD["S" S A1="CS",A2="S",DIEHGFLG="U"
40 E I DIEHD["P" S A1="PG",A2="G",DIEHGFLG="F"
41 E I DIEHD="V" S A1="VB",A2="VMB"
42 I DIEHFLD=.01,'$D(^DD(DIEHF,0,"UP")) S A1=A1_"F",A2=A2_"F"
43 I DIEHUFLG'["r",'$$VERFLG^DIEFU(DIEHUFLG,"bgA?"_C1_C2_A1_A2_$G(DIEHGFLG)) S DIEHEXIT=1
44 I DIEHUFLG["??" S DIEHUFLG=DIEHUFLG_C2_A2
45 E I DIEHUFLG["?" S DIEHUFLG=DIEHUFLG_C1_A1
46 E I DIEHUFLG["A" S DIEHUFLG=$TR(C1_C2_A1_A2,"S","U")
47 Q
48 ;
49ZERO(F,D) ;
50 I '$$VFILE^DIEFU(F,"D") Q 0
51 I '$$VFIELD^DIEFU(F,D,"D") Q 0
52 Q ^DD(F,D,0)
53 ;
54BN ;Insert blank node.
55 S:DIHELP DIHELP=DIHELP+1,^TMP("DIHELP",$J,DIHELP)=""
56 Q
57 ;
58HPROMPT(F,D) ;
59 N T
60 S T=$G(^DD(F,D,3))
61 I $L(T) D
62 . D BN
63 . S DIHELP=DIHELP+1,^TMP("DIHELP",$J,DIHELP)=T
64 Q
65 ;
66XHLP(DIEHF,DIEHFLD) ;
67 ;DA() and D0,D1,etc. passed thru symbol table.
68 N DIEHXH S DIEHXH=$G(^DD(DIEHF,DIEHFLD,4))
69 I $L(DIEHXH) D
70 . D BN
71 . N DIEHECNT S DIEHECNT=$G(DIERR)
72 . N DDIOLFLG S DDIOLFLG="H" X DIEHXH
73 . I DIEHECNT'=$G(DIERR) D HKERR^DILIBF(DIEHF,"",DIEHFLD,"Xecutable Help")
74 Q
75 ;
76DESCR(F,D) ;
77 N L
78 S L=$P($G(^DD(F,D,21,0)),U,3)
79 I L D
80 . D BN
81 . N I F I=1:1:L S DIHELP=DIHELP+1,^TMP("DIHELP",$J,DIHELP)=^DD(F,D,21,I,0)
82 . Q
83 Q
84 ;
85PXREFS(DIEHF,DIEHFLD) ;
86 N DIF,DIFD,DIEHROOT,DIEHIXID,DIEHIXP,DIEHIXNM,DIFULL
87 S DIEHIXP=$$FILENM^DIEFU(DIEHF)_" "
88 D GETIXNM(DIEHF,.DIEHIXNM)
89 S DIF=""
90 F S DIF=$O(DIEHIXNM(DIF)) Q:DIF="" D Q:$D(DIFULL)
91 . S DIFD=""
92 . F S DIFD=$O(DIEHIXNM(DIF,DIFD)) Q:DIFD="" D Q:$D(DIFULL)
93 . . I $L(DIEHIXP)+$L(DIEHIXNM(DIF,DIFD))>240 D Q
94 . . . S DIEHIXP=DIEHIXP_", etc "
95 . . . S DIFULL=1
96 . . S DIEHIXP=DIEHIXP_DIEHIXNM(DIF,DIFD)_", or "
97 S DIEHIXP=$E(DIEHIXP,1,$L(DIEHIXP)-5)
98 D BLD^DIALOG(9105,DIEHIXP)
99 Q
100 ;
101GETIXNM(DIEHF,DIEHIXNM) ;
102 S DIEHROOT=$$ROOT^DIQGU(DIEHF,"",1)
103 S DIEHIXID="Az"
104 F S DIEHIXID=$O(@DIEHROOT@(DIEHIXID)) Q:DIEHIXID="" D
105 . N DIEHIXF,DIEHIXFD
106 . S DIEHIXF=$O(^DD(DIEHF,0,"IX",DIEHIXID,"")) Q:DIEHIXF=""
107 . S DIEHIXFD=$O(^DD(DIEHF,0,"IX",DIEHIXID,DIEHIXF,"")) Q:DIEHIXFD=""
108 . S DIEHIXNM(DIEHIXF,DIEHIXFD)=$$FLDNM^DIEFU(DIEHIXF,DIEHIXFD)
109 Q
110 ;
111SCRNDES(F,D) ;
112 N T
113 S T=$G(^DD(F,D,12))
114 I $L(T) D
115 . D BN
116 . S DIHELP=DIHELP+1,^TMP("DIHELP",$J,DIHELP)=T
117 . Q
118 Q
119 ;
120SCRNCD(F,D,DIEHZ) ;
121 N S,DIC,Y,A,T,I
122 I $P(DIEHZ,U,2)'["*" D UNSCRNCD(DIEHZ) Q
123 S S=$G(^DD(F,D,12.1))
124 I S="" D UNSCRNCD(DIEHZ) Q
125 D CODES
126 I $D(Y) D
127 . N DIEHECNT S DIEHECNT=$G(DIERR)
128 . X S
129 . D BLD^DIALOG(9101)
130 . F I=1:1:T D
131 . . S Y=$P(Y(I),";",1)
132 . . X DIC("S") I D CODESOUT
133 . I DIEHECNT'=$G(DIERR) D HKERR^DILIBF(F,"",D,"set of codes screen")
134 Q
135UNSCRNCD(DIEHZ) ;
136 N Y,A,T,I
137 D CODES
138 I $D(Y) D
139 . D BLD^DIALOG(9101)
140 . F I=1:1:T D CODESOUT
141 . Q
142 Q
143 ;
144CODES ;
145 S A=$P(DIEHZ,U,3)
146 I A]"" D
147 . S T=$L(A,";")-1
148 . F I=1:1:T S Y(I)=$P(A,";",I)
149 . Q
150 Q
151 ;
152CODESOUT ;
153 S DIHELP=DIHELP+1,^TMP("DIHELP",$J,DIHELP)=$P(Y(I),":",1)_" "_$P(Y(I),":",2)
154 Q
155 ;
156VPMSG(F,D) ;
157 N I,N,P,L
158 D BLD^DIALOG(9103)
159 S I=0 F S I=$O(^DD(F,D,"V",I)) Q:I="B" S N=^(I,0) D
160 . S P(1)=$P(N,U,4),P(2)=$P(N,U,2),L=$S(I=1:"",1:"S")
161 . D BLD^DIALOG(9117,.P,.P,"",L)
162 . Q
163 Q
164 ;
165FOLLOW(DIEHPF,DIEHUFLG) ;
166 D GET(DIEHPF,"",.01,DIEHUFLG_"r")
167 Q
Note: See TracBrowser for help on using the repository browser.