Annotation of freem_fileman/DDSSTK.m, revision 1.1
1.1 ! snw 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")
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>