- DDGFSV ;SFISC/MKO- SAVE DATA ;12:41 PM 29 Mar 1995
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- 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)
- DDGFSV ;SFISC/MKO- SAVE DATA ;12:41 PM 29 Mar 1995
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- 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)
