Return to DDSSTK.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDSSTK	;SFISC/MKO-STACK CONTEXT, GO TO A NEW PAGE ;08:23 AM  1 Nov 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	N DDO
    5: 	N DDSBK,DDSDN,DDSFLD,DDSNP,DDSOPB,DDSPG,DDSPTB,DDSREP,DDSTP
    6: 	;
    7: 	I DDSSTACK?1"`".E D
    8: 	. S DDSSTACK=+$E(DDSSTACK,2,999)
    9: 	E  I DDSSTACK=+$P(DDSSTACK,"E") D
   10: 	. S DDSSTACK=+$O(^DIST(.403,+DDS,40,"B",DDSSTACK,""))
   11: 	E  D
   12: 	. S DDSSTACK=$O(^DIST(.403,+DDS,40,"C",$$UPCASE(DDSSTACK),""))
   13: 	;
   14: 	I 'DDSSTACK!($D(^DIST(.403,+DDS,40,+$G(DDSSTACK),0))[0) D  Q
   15: 	. K DDSSTACK,DDSBR
   16: 	;
   17: 	N DDSDAORG,DDSDLORG,DDSFLORG,DDSPG
   18: 	N:'$P(^DIST(.403,+DDS,40,+$G(DDSSTACK),0),U,6) DDSSC
   19: 	;
   20: 	S DDSPG=DDSSTACK
   21: 	K DDSSTACK,DDSBR
   22: 	;
   23: 	S DDSDLORG=DDSDL,DDSDAORG=DA
   24: 	F DDSI=1:1:DDSDL S DDSDAORG(DDSI)=DA(DDSI)
   25: 	K DDSI
   26: 	;
   27: 	S DDSSTK=1
   28: 	D PROC^DDS
   29: 	Q
   30: 	;
   31: UPCASE(X)	;
   32: 	;Return X in uppercase
   33: 	Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")