source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDSSTK.m@ 634

Last change on this file since 634 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 898 bytes
Line 
1DDSSTK ;SFISC/MKO-STACK CONTEXT, GO TO A NEW PAGE ;08:23 AM 1 Nov 1994
2 ;;22.0;VA FileMan;;Mar 30, 1999
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 ;
31UPCASE(X) ;
32 ;Return X in uppercase
33 Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Note: See TracBrowser for help on using the repository browser.