Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DDS7

DDS7.m

Go to the documentation of this file.
  1. DDS7 ;SFISC/MKO-Relational ;1:39 PM 28 Jun 1996
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. RPB(DDP,DDSFLD,DDSPG) ;Repaint pointed-to block(s) recursively
  1. N DDS7B
  1. S DDS7B=""
  1. F S DDS7B=$O(@DDSREFS@("PT",DDP,DDSFLD,DDSPG,DDS7B)) Q:DDS7B="" D
  1. . N DDP,DDSFLD
  1. . I $P($G(@DDSREFS@(DDSPG,DDS7B)),U,8) D
  1. .. D BLK^DDS1(DDSPG,DDS7B,"","",1)
  1. .. D DB^DDSR(DDSPG,DDS7B)
  1. . S DDP=$P($G(@DDSREFS@(DDSPG,DDS7B)),U,3)
  1. . D:$D(@DDSREFS@("PT",DDP))
  1. .. S DDSFLD=""
  1. .. F S DDSFLD=$O(@DDSREFS@("PT",DDP,DDSFLD)) Q:DDSFLD="" D
  1. ... D:$D(@DDSREFS@("PT",DDP,DDSFLD,DDSPG)) RPB(DDP,DDSFLD,DDSPG)
  1. Q
  1. ;
  1. RPF(DDP,DDSPTB,DDSDA,DA) ;Repaint and update pointer field of
  1. ;pointer blocks because user changed the .01 value
  1. S DDS7V=$G(@DDSREFT@("F"_DDP,DDSDA,.01,"D")) I DDS7V]"",$D(^("X"))#2 S DDS7V=^("X")
  1. S DDS7DAS=U_DA_U
  1. F DDS7I=$L(DDSPTB,U):-1:1 D Q:$G(DDS7FD)'=.01
  1. . S DDS7PTB=$P(DDSPTB,U,DDS7I)
  1. . D:DDS7PTB]"" RPF1
  1. K DDS7B,DDS7D,DDS7DA,DDS7DAS,DDS7DAST,DDS7DDO,DDS7FD,DDS7FI
  1. K DDS7I,DDS7L,DDS7PTB,DDS7REF,DDS7RJ,DDS7V,DDS7X
  1. Q
  1. RPF1 ;
  1. I DDS7PTB[";J" S DDS7FD="" Q
  1. S DDS7PTB=$P(DDS7PTB,";")
  1. I $L(DDS7PTB,",")=2 S DDS7FI=+DDS7PTB,DDS7FD=$P(DDS7PTB,",",2)
  1. E I $L(DDS7PTB,",")=3 S DDS7FI=0,DDS7FD=$P(DDS7PTB,",",2,3)
  1. E Q
  1. Q:DDS7FI=""!(DDS7FD="")
  1. ;
  1. ;Repaint pointer field on current page
  1. S DDS7B=""
  1. F S DDS7B=$O(@DDSREFS@("F"_DDS7FI,DDS7FD,"L",DDSPG,DDS7B)) Q:DDS7B="" D
  1. . S DDS7DDO=""
  1. . F S DDS7DDO=$O(@DDSREFS@("F"_DDS7FI,DDS7FD,"L",DDSPG,DDS7B,DDS7DDO)) Q:DDS7DDO="" D
  1. .. 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)
  1. .. X IOXY
  1. .. S DDS7X=$P(DDGLVID,DDGLDEL)_$E(DDS7V,1,DDS7L)_$P(DDGLVID,DDGLDEL,10)
  1. .. W $S(DDS7RJ:$J(" ",DDS7L-$L(DDS7V))_DDS7X,1:DDS7X_$J(" ",DDS7L-$L(DDS7V)))
  1. ;
  1. ;Reset external form of pointer data.
  1. ;
  1. ;If the pointer field is the .01, then we may have to follow back
  1. ;to pointers that point to this pointer block.
  1. ;
  1. ;DDS7DAS initially contains a list of records whose .01s we changed.
  1. ;DDS7DAST keeps a running list of all records in the pointer block
  1. ;that we change.
  1. ;DDS7DAS is finally set to this running list, so that when we go
  1. ;to update the pointer to the pointer block, we know which pointers
  1. ;to update.
  1. ;
  1. S DDS7DAST="",DDS7DA=" "
  1. F S DDS7DA=$O(@DDSREFT@("F"_DDS7FI,DDS7DA)) Q:DDS7DA'["," D
  1. . S DDS7REF=$NA(@DDSREFT@("F"_DDS7FI,DDS7DA,DDS7FD))
  1. . S DDS7D=$G(@DDS7REF@("D"))
  1. . I DDS7DAS[(U_$P(DDS7D,";")_U),$S(DDS7D[";":U_$P(DDS7D,";",2)=DIE,1:1) D
  1. .. I DDS7V="",DDS7FD'=.01 S @DDS7REF@("D")="",^("F")=3
  1. .. S:$D(@DDS7REF@("X"))#2 ^("X")=$S(DDS7V=""&(DDS7FD=.01):@DDS7REF@("D"),1:DDS7V)
  1. .. I DDS7FD=.01,DDS7DAST_U'[(U_+DDS7DA_U) S DDS7DAST=DDS7DAST_U_+DDS7DA
  1. S DDS7DAS=DDS7DAST_U
  1. Q