DDS7 ;SFISC/MKO-Relational ;1:39 PM 28 Jun 1996
;;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.
;
RPB(DDP,DDSFLD,DDSPG) ;Repaint pointed-to block(s) recursively
N DDS7B
S DDS7B=""
F S DDS7B=$O(@DDSREFS@("PT",DDP,DDSFLD,DDSPG,DDS7B)) Q:DDS7B="" D
. N DDP,DDSFLD
. I $P($G(@DDSREFS@(DDSPG,DDS7B)),U,8) D
.. D BLK^DDS1(DDSPG,DDS7B,"","",1)
.. D DB^DDSR(DDSPG,DDS7B)
. S DDP=$P($G(@DDSREFS@(DDSPG,DDS7B)),U,3)
. D:$D(@DDSREFS@("PT",DDP))
.. S DDSFLD=""
.. F S DDSFLD=$O(@DDSREFS@("PT",DDP,DDSFLD)) Q:DDSFLD="" D
... D:$D(@DDSREFS@("PT",DDP,DDSFLD,DDSPG)) RPB(DDP,DDSFLD,DDSPG)
Q
;
RPF(DDP,DDSPTB,DDSDA,DA) ;Repaint and update pointer field of
;pointer blocks because user changed the .01 value
S DDS7V=$G(@DDSREFT@("F"_DDP,DDSDA,.01,"D")) I DDS7V]"",$D(^("X"))#2 S DDS7V=^("X")
S DDS7DAS=U_DA_U
F DDS7I=$L(DDSPTB,U):-1:1 D Q:$G(DDS7FD)'=.01
. S DDS7PTB=$P(DDSPTB,U,DDS7I)
. D:DDS7PTB]"" RPF1
K DDS7B,DDS7D,DDS7DA,DDS7DAS,DDS7DAST,DDS7DDO,DDS7FD,DDS7FI
K DDS7I,DDS7L,DDS7PTB,DDS7REF,DDS7RJ,DDS7V,DDS7X
Q
RPF1 ;
I DDS7PTB[";J" S DDS7FD="" Q
S DDS7PTB=$P(DDS7PTB,";")
I $L(DDS7PTB,",")=2 S DDS7FI=+DDS7PTB,DDS7FD=$P(DDS7PTB,",",2)
E I $L(DDS7PTB,",")=3 S DDS7FI=0,DDS7FD=$P(DDS7PTB,",",2,3)
E Q
Q:DDS7FI=""!(DDS7FD="")
;
;Repaint pointer field on current page
S DDS7B=""
F S DDS7B=$O(@DDSREFS@("F"_DDS7FI,DDS7FD,"L",DDSPG,DDS7B)) Q:DDS7B="" D
. S DDS7DDO=""
. F S DDS7DDO=$O(@DDSREFS@("F"_DDS7FI,DDS7FD,"L",DDSPG,DDS7B,DDS7DDO)) Q:DDS7DDO="" D
.. Q:$G(@DDSREFS@(DDSPG,DDS7B,DDS7DDO,"D"))="" S DY=+^("D"),DX=$P(^("D"),U,2),DDS7L=$P(^("D"),U,3),DDS7RJ=$P(^("D"),U,10)
.. X IOXY
.. S DDS7X=$P(DDGLVID,DDGLDEL)_$E(DDS7V,1,DDS7L)_$P(DDGLVID,DDGLDEL,10)
.. W $S(DDS7RJ:$J(" ",DDS7L-$L(DDS7V))_DDS7X,1:DDS7X_$J(" ",DDS7L-$L(DDS7V)))
;
;Reset external form of pointer data.
;
;If the pointer field is the .01, then we may have to follow back
;to pointers that point to this pointer block.
;
;DDS7DAS initially contains a list of records whose .01s we changed.
;DDS7DAST keeps a running list of all records in the pointer block
;that we change.
;DDS7DAS is finally set to this running list, so that when we go
;to update the pointer to the pointer block, we know which pointers
;to update.
;
S DDS7DAST="",DDS7DA=" "
F S DDS7DA=$O(@DDSREFT@("F"_DDS7FI,DDS7DA)) Q:DDS7DA'["," D
. S DDS7REF=$NA(@DDSREFT@("F"_DDS7FI,DDS7DA,DDS7FD))
. S DDS7D=$G(@DDS7REF@("D"))
. I DDS7DAS[(U_$P(DDS7D,";")_U),$S(DDS7D[";":U_$P(DDS7D,";",2)=DIE,1:1) D
.. I DDS7V="",DDS7FD'=.01 S @DDS7REF@("D")="",^("F")=3
.. S:$D(@DDS7REF@("X"))#2 ^("X")=$S(DDS7V=""&(DDS7FD=.01):@DDS7REF@("D"),1:DDS7V)
.. I DDS7FD=.01,DDS7DAST_U'[(U_+DDS7DA_U) S DDS7DAST=DDS7DAST_U_+DDS7DA
S DDS7DAS=DDS7DAST_U
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDS7 3053 printed Dec 13, 2024@02:43:09 Page 2
DDS7 ;SFISC/MKO-Relational ;1:39 PM 28 Jun 1996
+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 ;
RPB(DDP,DDSFLD,DDSPG) ;Repaint pointed-to block(s) recursively
+1 NEW DDS7B
+2 SET DDS7B=""
+3 FOR
SET DDS7B=$ORDER(@DDSREFS@("PT",DDP,DDSFLD,DDSPG,DDS7B))
if DDS7B=""
QUIT
Begin DoDot:1
+4 NEW DDP,DDSFLD
+5 IF $PIECE($GET(@DDSREFS@(DDSPG,DDS7B)),U,8)
Begin DoDot:2
+6 DO BLK^DDS1(DDSPG,DDS7B,"","",1)
+7 DO DB^DDSR(DDSPG,DDS7B)
End DoDot:2
+8 SET DDP=$PIECE($GET(@DDSREFS@(DDSPG,DDS7B)),U,3)
+9 if $DATA(@DDSREFS@("PT",DDP))
Begin DoDot:2
+10 SET DDSFLD=""
+11 FOR
SET DDSFLD=$ORDER(@DDSREFS@("PT",DDP,DDSFLD))
if DDSFLD=""
QUIT
Begin DoDot:3
+12 if $DATA(@DDSREFS@("PT",DDP,DDSFLD,DDSPG))
DO RPB(DDP,DDSFLD,DDSPG)
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
RPF(DDP,DDSPTB,DDSDA,DA) ;Repaint and update pointer field of
+1 ;pointer blocks because user changed the .01 value
+2 SET DDS7V=$GET(@DDSREFT@("F"_DDP,DDSDA,.01,"D"))
IF DDS7V]""
IF $DATA(^("X"))#2
SET DDS7V=^("X")
+3 SET DDS7DAS=U_DA_U
+4 FOR DDS7I=$LENGTH(DDSPTB,U):-1:1
Begin DoDot:1
+5 SET DDS7PTB=$PIECE(DDSPTB,U,DDS7I)
+6 if DDS7PTB]""
DO RPF1
End DoDot:1
if $GET(DDS7FD)'=.01
QUIT
+7 KILL DDS7B,DDS7D,DDS7DA,DDS7DAS,DDS7DAST,DDS7DDO,DDS7FD,DDS7FI
+8 KILL DDS7I,DDS7L,DDS7PTB,DDS7REF,DDS7RJ,DDS7V,DDS7X
+9 QUIT
RPF1 ;
+1 IF DDS7PTB[";J"
SET DDS7FD=""
QUIT
+2 SET DDS7PTB=$PIECE(DDS7PTB,";")
+3 IF $LENGTH(DDS7PTB,",")=2
SET DDS7FI=+DDS7PTB
SET DDS7FD=$PIECE(DDS7PTB,",",2)
+4 IF '$TEST
IF $LENGTH(DDS7PTB,",")=3
SET DDS7FI=0
SET DDS7FD=$PIECE(DDS7PTB,",",2,3)
+5 IF '$TEST
QUIT
+6 if DDS7FI=""!(DDS7FD="")
QUIT
+7 ;
+8 ;Repaint pointer field on current page
+9 SET DDS7B=""
+10 FOR
SET DDS7B=$ORDER(@DDSREFS@("F"_DDS7FI,DDS7FD,"L",DDSPG,DDS7B))
if DDS7B=""
QUIT
Begin DoDot:1
+11 SET DDS7DDO=""
+12 FOR
SET DDS7DDO=$ORDER(@DDSREFS@("F"_DDS7FI,DDS7FD,"L",DDSPG,DDS7B,DDS7DDO))
if DDS7DDO=""
QUIT
Begin DoDot:2
+13 if $GET(@DDSREFS@(DDSPG,DDS7B,DDS7DDO,"D"))=""
QUIT
SET DY=+^("D")
SET DX=$PIECE(^("D"),U,2)
SET DDS7L=$PIECE(^("D"),U,3)
SET DDS7RJ=$PIECE(^("D"),U,10)
+14 XECUTE IOXY
+15 SET DDS7X=$PIECE(DDGLVID,DDGLDEL)_$EXTRACT(DDS7V,1,DDS7L)_$PIECE(DDGLVID,DDGLDEL,10)
+16 WRITE $SELECT(DDS7RJ:$JUSTIFY(" ",DDS7L-$LENGTH(DDS7V))_DDS7X,1:DDS7X_$JUSTIFY(" ",DDS7L-$LENGTH(DDS7V)))
End DoDot:2
End DoDot:1
+17 ;
+18 ;Reset external form of pointer data.
+19 ;
+20 ;If the pointer field is the .01, then we may have to follow back
+21 ;to pointers that point to this pointer block.
+22 ;
+23 ;DDS7DAS initially contains a list of records whose .01s we changed.
+24 ;DDS7DAST keeps a running list of all records in the pointer block
+25 ;that we change.
+26 ;DDS7DAS is finally set to this running list, so that when we go
+27 ;to update the pointer to the pointer block, we know which pointers
+28 ;to update.
+29 ;
+30 SET DDS7DAST=""
SET DDS7DA=" "
+31 FOR
SET DDS7DA=$ORDER(@DDSREFT@("F"_DDS7FI,DDS7DA))
if DDS7DA'[","
QUIT
Begin DoDot:1
+32 SET DDS7REF=$NAME(@DDSREFT@("F"_DDS7FI,DDS7DA,DDS7FD))
+33 SET DDS7D=$GET(@DDS7REF@("D"))
+34 IF DDS7DAS[(U_$PIECE(DDS7D,";")_U)
IF $SELECT(DDS7D[";":U_$PIECE(DDS7D,";",2)=DIE,1:1)
Begin DoDot:2
+35 IF DDS7V=""
IF DDS7FD'=.01
SET @DDS7REF@("D")=""
SET ^("F")=3
+36 if $DATA(@DDS7REF@("X"))#2
SET ^("X")=$SELECT(DDS7V=""&(DDS7FD=.01):@DDS7REF@("D"),1:DDS7V)
+37 IF DDS7FD=.01
IF DDS7DAST_U'[(U_+DDS7DA_U)
SET DDS7DAST=DDS7DAST_U_+DDS7DA
End DoDot:2
End DoDot:1
+38 SET DDS7DAS=DDS7DAST_U
+39 QUIT
