Return to DDSSTK.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDSSTK.m, revision 1.1.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")