source: FOIAVistA/tag/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDGFSV.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 2.2 KB
Line 
1DDGFSV ;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.
4SAVE ;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 ;
17PG ;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 ;
35BK ;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 ;
47FD ;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 ;
64STPU(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)
Note: See TracBrowser for help on using the repository browser.