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>