File:  [Coherent Logic Development] / freem_fileman / USER / DDSSTK.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (5 weeks, 5 days ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

DDSSTK	;SFISC/MKO-STACK CONTEXT, GO TO A NEW PAGE ;08:23 AM  1 Nov 1994
	;;21.0;VA FileMan;;Dec 28, 1994
	;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")

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>