DDGFSV ;SFISC/MKO- SAVE DATA ;12:41 PM 29 Mar 1995
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
SAVE ;Save in form/block files data in DDGFREF
N P,B,F,P1,B1,F1,N
;
I '$G(DDGFCHG) D MSG^DDGF("Nothing to save.") H 1 D MSG^DDGF() Q
D MSG^DDGF("Saving data ...")
;
;Loop through all pages in DDGFREF
S P="" F S P=$O(@DDGFREF@("F",P)) Q:P="" D PG
;
D MSG^DDGF("Data saved.") H 1 D MSG^DDGF()
S DDGFCHG=0
Q
;
PG ;Save page data
S P1=@DDGFREF@("F",P)
I $P(P1,U,7),$D(^DIST(.403,+DDGFFM,40,P,0))#2 D
. S N=^DIST(.403,+DDGFFM,40,P,0)
. S $P(N,U,3)=$P(P1,U)+1_","_($P(P1,U,2)+1)
. 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))
. S ^DIST(.403,+DDGFFM,40,P,0)=$$STPU(N)
. ;
. S N=$G(^DIST(.403,+DDGFFM,40,P,1))
. I $P(N,U)'=$P(P1,U,5) D
.. S DIE="^DIST(.403,"_+DDGFFM_",40,"
.. S DR="7////"_$P(P1,U,5),DA(1)=+DDGFFM,DA=P
.. N P D ^DIE K DIE,DR,DA
;
;Loop through all blocks
S B="" F S B=$O(@DDGFREF@("F",P,B)) Q:B="" D BK
Q
;
BK ;Save block data
S B1=@DDGFREF@("F",P,B)
I $P(B1,U,5),$D(^DIST(.403,+DDGFFM,40,P,40,B,0))#2 D
. 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)
. I $P(^DIST(.404,B,0),U)'=$P(B1,U,4) D
.. S DIE="^DIST(.404,",DR=".01////"_$P(B1,U,4),DA=B
.. N B,P D ^DIE K DIE,DR,DA
;
;Loop through all fields
S F="" F S F=$O(@DDGFREF@("F",P,B,F)) Q:F="" D FD
Q
;
FD ;Save field data
S F1=@DDGFREF@("F",P,B,F)
I $P(F1,U,9),$D(^DIST(.404,B,40,F,0))#2 D
. S N=""
. 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)
. 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)
. S:$P(^DIST(.404,B,40,F,0),U,3)=1 $P(N,U,4)=""
. S ^DIST(.404,B,40,F,2)=$$STPU(N)
. ;
. ;Use DIE to stuff in new caption
. I $P(^DIST(.404,B,40,F,0),U,2)'=$P(F1,U,4) D
.. S DIE="^DIST(.404,"_B_",40,"
.. 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))
.. S DA(1)=B,DA=F
.. N P,B,F D ^DIE K DIE,DR,DA
Q
;
STPU(X) ;Strip trailing up-arrows from X
N I
F I=$L(X):-1:0 Q:$E(X,I)'="^"
Q $E(X,1,I)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDGFSV 2570 printed Nov 22, 2024@17:52:24 Page 2
DDGFSV ;SFISC/MKO- SAVE DATA ;12:41 PM 29 Mar 1995
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
SAVE ;Save in form/block files data in DDGFREF
+1 NEW P,B,F,P1,B1,F1,N
+2 ;
+3 IF '$GET(DDGFCHG)
DO MSG^DDGF("Nothing to save.")
HANG 1
DO MSG^DDGF()
QUIT
+4 DO MSG^DDGF("Saving data ...")
+5 ;
+6 ;Loop through all pages in DDGFREF
+7 SET P=""
FOR
SET P=$ORDER(@DDGFREF@("F",P))
if P=""
QUIT
DO PG
+8 ;
+9 DO MSG^DDGF("Data saved.")
HANG 1
DO MSG^DDGF()
+10 SET DDGFCHG=0
+11 QUIT
+12 ;
PG ;Save page data
+1 SET P1=@DDGFREF@("F",P)
+2 IF $PIECE(P1,U,7)
IF $DATA(^DIST(.403,+DDGFFM,40,P,0))#2
Begin DoDot:1
+3 SET N=^DIST(.403,+DDGFFM,40,P,0)
+4 SET $PIECE(N,U,3)=$PIECE(P1,U)+1_","_($PIECE(P1,U,2)+1)
+5 SET $PIECE(N,U,6,7)=$SELECT($PIECE(P1,U,3)="":U,1:1_U_($PIECE(P1,U,3)+1)_","_($PIECE(P1,U,4)+1))
+6 SET ^DIST(.403,+DDGFFM,40,P,0)=$$STPU(N)
+7 ;
+8 SET N=$GET(^DIST(.403,+DDGFFM,40,P,1))
+9 IF $PIECE(N,U)'=$PIECE(P1,U,5)
Begin DoDot:2
+10 SET DIE="^DIST(.403,"_+DDGFFM_",40,"
+11 SET DR="7////"_$PIECE(P1,U,5)
SET DA(1)=+DDGFFM
SET DA=P
+12 NEW P
DO ^DIE
KILL DIE,DR,DA
End DoDot:2
End DoDot:1
+13 ;
+14 ;Loop through all blocks
+15 SET B=""
FOR
SET B=$ORDER(@DDGFREF@("F",P,B))
if B=""
QUIT
DO BK
+16 QUIT
+17 ;
BK ;Save block data
+1 SET B1=@DDGFREF@("F",P,B)
+2 IF $PIECE(B1,U,5)
IF $DATA(^DIST(.403,+DDGFFM,40,P,40,B,0))#2
Begin DoDot:1
+3 SET $PIECE(^DIST(.403,+DDGFFM,40,P,40,B,0),U,3)=$PIECE(B1,U)-$PIECE(P1,U)+1_","_($PIECE(B1,U,2)-$PIECE(P1,U,2)+1)
+4 IF $PIECE(^DIST(.404,B,0),U)'=$PIECE(B1,U,4)
Begin DoDot:2
+5 SET DIE="^DIST(.404,"
SET DR=".01////"_$PIECE(B1,U,4)
SET DA=B
+6 NEW B,P
DO ^DIE
KILL DIE,DR,DA
End DoDot:2
End DoDot:1
+7 ;
+8 ;Loop through all fields
+9 SET F=""
FOR
SET F=$ORDER(@DDGFREF@("F",P,B,F))
if F=""
QUIT
DO FD
+10 QUIT
+11 ;
FD ;Save field data
+1 SET F1=@DDGFREF@("F",P,B,F)
+2 IF $PIECE(F1,U,9)
IF $DATA(^DIST(.404,B,40,F,0))#2
Begin DoDot:1
+3 SET N=""
+4 SET $PIECE(N,U,1,2)=$SELECT($PIECE(F1,U,8):$SELECT($PIECE(F1,U,5)]""&($PIECE(F1,U,6)]""):$PIECE(F1,U,5)-$PIECE(B1,U)+1_","_($PIECE(F1,U,6)-$PIECE(B1,U,2)+1),1:"")_U_$PIECE(F1,U,8),1:U)
+5 SET $PIECE(N,U,3,4)=$SELECT($LENGTH($PIECE(F1,U,4)):$SELECT($PIECE(F1,U)]""&($PIECE(F1,U,2)]""):$PIECE(F1,U)-$PIECE(B1,U)+1_","_($PIECE(F1,U,2)-$PIECE(B1,U,2)+1),1:"")_U_$SELECT($PIECE(F1,U,4)?.E1":":"",1:1),1:U)
+6 if $PIECE(^DIST(.404,B,40,F,0),U,3)=1
SET $PIECE(N,U,4)=""
+7 SET ^DIST(.404,B,40,F,2)=$$STPU(N)
+8 ;
+9 ;Use DIE to stuff in new caption
+10 IF $PIECE(^DIST(.404,B,40,F,0),U,2)'=$PIECE(F1,U,4)
Begin DoDot:2
+11 SET DIE="^DIST(.404,"_B_",40,"
+12 SET DR="1////"_$SELECT($PIECE(F1,U,4)?.1":":"@",$PIECE(F1,U,4)?1.E1":":$EXTRACT($PIECE(F1,U,4),1,$LENGTH($PIECE(F1,U,4))-1),1:$PIECE(F1,U,4))
+13 SET DA(1)=B
SET DA=F
+14 NEW P,B,F
DO ^DIE
KILL DIE,DR,DA
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
STPU(X) ;Strip trailing up-arrows from X
+1 NEW I
+2 FOR I=$LENGTH(X):-1:0
if $EXTRACT(X,I)'="^"
QUIT
+3 QUIT $EXTRACT(X,1,I)
