| 1 | DDGFSV ;SFISC/MKO- SAVE DATA ;12:41 PM 29 Mar 1995
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 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:$P(^DIST(.404,B,40,F,0),U,3)=1 $P(N,U,4)=""
|
|---|
| 54 | . S ^DIST(.404,B,40,F,2)=$$STPU(N)
|
|---|
| 55 | . ;
|
|---|
| 56 | . ;Use DIE to stuff in new caption
|
|---|
| 57 | . I $P(^DIST(.404,B,40,F,0),U,2)'=$P(F1,U,4) D
|
|---|
| 58 | .. S DIE="^DIST(.404,"_B_",40,"
|
|---|
| 59 | .. 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))
|
|---|
| 60 | .. S DA(1)=B,DA=F
|
|---|
| 61 | .. N P,B,F D ^DIE K DIE,DR,DA
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | STPU(X) ;Strip trailing up-arrows from X
|
|---|
| 65 | N I
|
|---|
| 66 | F I=$L(X):-1:0 Q:$E(X,I)'="^"
|
|---|
| 67 | Q $E(X,1,I)
|
|---|
