Return to DDGFSV.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDGFSV	;SFISC/MKO- SAVE DATA ;02:58 PM  18 May 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: SAVE	;Save in form/block files data in DDGFREF
    5: 	N P,B,F,P1,B1,F1,N
    6: 	;
    7: 	I '$G(DDGFCHG) D MSG^DDGF("Nothing to save.") H 1 D MSG^DDGF() Q
    8: 	D MSG^DDGF("Saving data ...")
    9: 	;
   10: 	;Loop through all pages in DDGFREF
   11: 	S P="" F  S P=$O(@DDGFREF@("F",P)) Q:P=""  D PG
   12: 	;
   13: 	D MSG^DDGF("Data saved.") H 1 D MSG^DDGF()
   14: 	S DDGFCHG=0
   15: 	Q
   16: 	;
   17: PG	;Save page data
   18: 	S P1=@DDGFREF@("F",P)
   19: 	I $P(P1,U,7),$D(^DIST(.403,+DDGFFM,40,P,0))#2 D
   20: 	. S N=^DIST(.403,+DDGFFM,40,P,0)
   21: 	. S $P(N,U,3)=$P(P1,U)+1_","_($P(P1,U,2)+1)
   22: 	. S $P(N,U,6,7)=$S($P(P1,U,3)="":U,1:1_U_($P(P1,U,3)+1)_","_($P(P1,U,4)+1))
   23: 	. S ^DIST(.403,+DDGFFM,40,P,0)=$$STPU(N)
   24: 	. ;
   25: 	. S N=$G(^DIST(.403,+DDGFFM,40,P,1))
   26: 	. I $P(N,U)'=$P(P1,U,5) D
   27: 	.. S DIE="^DIST(.403,"_+DDGFFM_",40,"
   28: 	.. S DR="7////"_$P(P1,U,5),DA(1)=+DDGFFM,DA=P
   29: 	.. N P D ^DIE K DIE,DR,DA
   30: 	;
   31: 	;Loop through all blocks
   32: 	S B="" F  S B=$O(@DDGFREF@("F",P,B)) Q:B=""  D BK
   33: 	Q
   34: 	;
   35: BK	;Save block data
   36: 	S B1=@DDGFREF@("F",P,B)
   37: 	I $P(B1,U,5),$D(^DIST(.403,+DDGFFM,40,P,40,B,0))#2 D
   38: 	. S $P(^DIST(.403,+DDGFFM,40,P,40,B,0),U,3)=$P(B1,U)-$P(P1,U)+1_","_($P(B1,U,2)-$P(P1,U,2)+1)
   39: 	. I $P(^DIST(.404,B,0),U)'=$P(B1,U,4) D
   40: 	.. S DIE="^DIST(.404,",DR=".01////"_$P(B1,U,4),DA=B
   41: 	.. N B,P D ^DIE K DIE,DR,DA
   42: 	;
   43: 	;Loop through all fields
   44: 	S F="" F  S F=$O(@DDGFREF@("F",P,B,F)) Q:F=""  D FD
   45: 	Q
   46: 	;
   47: FD	;Save field data
   48: 	S F1=@DDGFREF@("F",P,B,F)
   49: 	I $P(F1,U,9),$D(^DIST(.404,B,40,F,0))#2 D
   50: 	. S N=""
   51: 	. S $P(N,U,1,2)=$S($P(F1,U,8):$S($P(F1,U,5)]""&($P(F1,U,6)]""):$P(F1,U,5)-$P(B1,U)+1_","_($P(F1,U,6)-$P(B1,U,2)+1),1:"")_U_$P(F1,U,8),1:U)
   52: 	. S $P(N,U,3,4)=$S($L($P(F1,U,4)):$S($P(F1,U)]""&($P(F1,U,2)]""):$P(F1,U)-$P(B1,U)+1_","_($P(F1,U,2)-$P(B1,U,2)+1),1:"")_U_$S($P(F1,U,4)?.E1":":"",1:1),1:U)
   53: 	. S ^DIST(.404,B,40,F,2)=$$STPU(N)
   54: 	. ;
   55: 	. ;Use DIE to stuff in new caption
   56: 	. I $P(^DIST(.404,B,40,F,0),U,2)'=$P(F1,U,4) D
   57: 	.. S DIE="^DIST(.404,"_B_",40,"
   58: 	.. S DR="1////"_$S($P(F1,U,4)?.1":":"@",$P(F1,U,4)?1.E1":":$E($P(F1,U,4),1,$L($P(F1,U,4))-1),1:$P(F1,U,4))
   59: 	.. S DA(1)=B,DA=F
   60: 	.. N P,B,F D ^DIE K DIE,DR,DA
   61: 	Q
   62: 	;
   63: STPU(X)	;Strip trailing up-arrows from X
   64: 	N I
   65: 	F I=$L(X):-1:0 Q:$E(X,I)'="^"
   66: 	Q $E(X,1,I)