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

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1DDGFASUB ;SFISC/MKO-MANAGE "ASUB" ARRAY ;09:36 AM 29 Mar 1994
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5ALL ;Get subpages into @DDGFREF@("ASUB")
6 N P,B S P=0
7 F S P=$O(^DIST(.403,+DDGFFM,40,P)) Q:'P D:$P($G(^(P,1)),U,2)]"" ADD(P)
8 Q
9 ;
10ADD(P) ;
11 ;Setup @DDGFREF@("ASUB",pg,bk,ddo)=subpage P
12 N MP,MB,MF,X
13 S MF=$$UC($P(^DIST(.403,+DDGFFM,40,P,1),U,2)) Q:MF=""
14 S MP=$P(MF,",",3),MB=$P(MF,",",2),MF=$P(MF,",")
15 ;
16 S MP=$O(^DIST(.403,+DDGFFM,40,$S(MP=+$P(MP,"E"):"B",1:"C"),MP,""))
17 Q:MP=""
18 ;
19 I MB=+$P(MB,"E") D
20 . S MB=$O(^DIST(.403,+DDGFFM,40,MP,40,"AC",MB,""))
21 E D
22 . S MB=$O(^DIST(.404,"B",$$UC(MB),"")) Q:MB=""
23 . S MB=$O(^DIST(.403,+DDGFFM,40,MP,40,"B",MB,""))
24 Q:MB=""
25 ;
26 S X=$S(MF=+$P(MF,"E"):"B",$D(^DIST(.404,MB,40,"D",MF)):"D",1:"C")
27 S MF=$O(^DIST(.404,MB,40,X,MF,"")) Q:MF=""
28 S @DDGFREF@("ASUB",MP,MB,MF)=P,@DDGFREF@("ASUB","B",P,MP,MB,MF)=""
29 Q
30 ;
31DEL(P) ;
32 ;Delete subpage DDGFPG from @DDGFREF@("ASUB")
33 Q:'$D(@DDGFREF@("ASUB","B",P))
34 ;
35 N MP,MB,MF
36 S MP="" F S MP=$O(@DDGFREF@("ASUB","B",P,MP)) Q:MP="" D
37 . S MB="" F S MB=$O(@DDGFREF@("ASUB","B",P,MP,MB)) Q:MB="" D
38 .. S MF="" F S MF=$O(@DDGFREF@("ASUB","B",P,MP,MB,MF)) Q:MF="" D
39 ... K @DDGFREF@("ASUB","B",P,MP,MB,MF),@DDGFREF@("ASUB",MP,MB,MF)
40 Q
41 ;
42EDIT(P) ;
43 ;Edit "ASUB" to reflect new parent page
44 D DEL(P),ADD(P)
45 Q
46UC(X) ;
47 Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Note: See TracBrowser for help on using the repository browser.