| [613] | 1 | DDGFASUB ;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 | ;
|
|---|
| 5 | ALL ;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 | ;
|
|---|
| 10 | ADD(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 | ;
|
|---|
| 31 | DEL(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 | ;
|
|---|
| 42 | EDIT(P) ;
|
|---|
| 43 | ;Edit "ASUB" to reflect new parent page
|
|---|
| 44 | D DEL(P),ADD(P)
|
|---|
| 45 | Q
|
|---|
| 46 | UC(X) ;
|
|---|
| 47 | Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
