Return to DDGFASUB.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDGFASUB	;SFISC/MKO-MANAGE "ASUB" ARRAY ;09:36 AM  29 Mar 1994;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    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")