34 lines
898 B
Mathematica
34 lines
898 B
Mathematica
DDSSTK ;SFISC/MKO-STACK CONTEXT, GO TO A NEW PAGE ;08:23 AM 1 Nov 1994
|
|
;;22.0;VA FileMan;;Mar 30, 1999
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
N DDO
|
|
N DDSBK,DDSDN,DDSFLD,DDSNP,DDSOPB,DDSPG,DDSPTB,DDSREP,DDSTP
|
|
;
|
|
I DDSSTACK?1"`".E D
|
|
. S DDSSTACK=+$E(DDSSTACK,2,999)
|
|
E I DDSSTACK=+$P(DDSSTACK,"E") D
|
|
. S DDSSTACK=+$O(^DIST(.403,+DDS,40,"B",DDSSTACK,""))
|
|
E D
|
|
. S DDSSTACK=$O(^DIST(.403,+DDS,40,"C",$$UPCASE(DDSSTACK),""))
|
|
;
|
|
I 'DDSSTACK!($D(^DIST(.403,+DDS,40,+$G(DDSSTACK),0))[0) D Q
|
|
. K DDSSTACK,DDSBR
|
|
;
|
|
N DDSDAORG,DDSDLORG,DDSFLORG,DDSPG
|
|
N:'$P(^DIST(.403,+DDS,40,+$G(DDSSTACK),0),U,6) DDSSC
|
|
;
|
|
S DDSPG=DDSSTACK
|
|
K DDSSTACK,DDSBR
|
|
;
|
|
S DDSDLORG=DDSDL,DDSDAORG=DA
|
|
F DDSI=1:1:DDSDL S DDSDAORG(DDSI)=DA(DDSI)
|
|
K DDSI
|
|
;
|
|
S DDSSTK=1
|
|
D PROC^DDS
|
|
Q
|
|
;
|
|
UPCASE(X) ;
|
|
;Return X in uppercase
|
|
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|