source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDS7.m@ 1714

Last change on this file since 1714 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1DDS7 ;SFISC/MKO-Relational ;1:39 PM 28 Jun 1996
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4RPB(DDP,DDSFLD,DDSPG) ;Repaint pointed-to block(s) recursively
5 N DDS7B
6 S DDS7B=""
7 F S DDS7B=$O(@DDSREFS@("PT",DDP,DDSFLD,DDSPG,DDS7B)) Q:DDS7B="" D
8 . N DDP,DDSFLD
9 . I $P($G(@DDSREFS@(DDSPG,DDS7B)),U,8) D
10 .. D BLK^DDS1(DDSPG,DDS7B,"","",1)
11 .. D DB^DDSR(DDSPG,DDS7B)
12 . S DDP=$P($G(@DDSREFS@(DDSPG,DDS7B)),U,3)
13 . D:$D(@DDSREFS@("PT",DDP))
14 .. S DDSFLD=""
15 .. F S DDSFLD=$O(@DDSREFS@("PT",DDP,DDSFLD)) Q:DDSFLD="" D
16 ... D:$D(@DDSREFS@("PT",DDP,DDSFLD,DDSPG)) RPB(DDP,DDSFLD,DDSPG)
17 Q
18 ;
19RPF(DDP,DDSPTB,DDSDA,DA) ;Repaint and update pointer field of
20 ;pointer blocks because user changed the .01 value
21 S DDS7V=$G(@DDSREFT@("F"_DDP,DDSDA,.01,"D")) I DDS7V]"",$D(^("X"))#2 S DDS7V=^("X")
22 S DDS7DAS=U_DA_U
23 F DDS7I=$L(DDSPTB,U):-1:1 D Q:$G(DDS7FD)'=.01
24 . S DDS7PTB=$P(DDSPTB,U,DDS7I)
25 . D:DDS7PTB]"" RPF1
26 K DDS7B,DDS7D,DDS7DA,DDS7DAS,DDS7DAST,DDS7DDO,DDS7FD,DDS7FI
27 K DDS7I,DDS7L,DDS7PTB,DDS7REF,DDS7RJ,DDS7V,DDS7X
28 Q
29RPF1 ;
30 I DDS7PTB[";J" S DDS7FD="" Q
31 S DDS7PTB=$P(DDS7PTB,";")
32 I $L(DDS7PTB,",")=2 S DDS7FI=+DDS7PTB,DDS7FD=$P(DDS7PTB,",",2)
33 E I $L(DDS7PTB,",")=3 S DDS7FI=0,DDS7FD=$P(DDS7PTB,",",2,3)
34 E Q
35 Q:DDS7FI=""!(DDS7FD="")
36 ;
37 ;Repaint pointer field on current page
38 S DDS7B=""
39 F S DDS7B=$O(@DDSREFS@("F"_DDS7FI,DDS7FD,"L",DDSPG,DDS7B)) Q:DDS7B="" D
40 . S DDS7DDO=""
41 . F S DDS7DDO=$O(@DDSREFS@("F"_DDS7FI,DDS7FD,"L",DDSPG,DDS7B,DDS7DDO)) Q:DDS7DDO="" D
42 .. 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)
43 .. X IOXY
44 .. S DDS7X=$P(DDGLVID,DDGLDEL)_$E(DDS7V,1,DDS7L)_$P(DDGLVID,DDGLDEL,10)
45 .. W $S(DDS7RJ:$J(" ",DDS7L-$L(DDS7V))_DDS7X,1:DDS7X_$J(" ",DDS7L-$L(DDS7V)))
46 ;
47 ;Reset external form of pointer data.
48 ;
49 ;If the pointer field is the .01, then we may have to follow back
50 ;to pointers that point to this pointer block.
51 ;
52 ;DDS7DAS initially contains a list of records whose .01s we changed.
53 ;DDS7DAST keeps a running list of all records in the pointer block
54 ;that we change.
55 ;DDS7DAS is finally set to this running list, so that when we go
56 ;to update the pointer to the pointer block, we know which pointers
57 ;to update.
58 ;
59 S DDS7DAST="",DDS7DA=" "
60 F S DDS7DA=$O(@DDSREFT@("F"_DDS7FI,DDS7DA)) Q:DDS7DA'["," D
61 . S DDS7REF=$NA(@DDSREFT@("F"_DDS7FI,DDS7DA,DDS7FD))
62 . S DDS7D=$G(@DDS7REF@("D"))
63 . I DDS7DAS[(U_$P(DDS7D,";")_U),$S(DDS7D[";":U_$P(DDS7D,";",2)=DIE,1:1) D
64 .. I DDS7V="",DDS7FD'=.01 S @DDS7REF@("D")="",^("F")=3
65 .. S:$D(@DDS7REF@("X"))#2 ^("X")=$S(DDS7V=""&(DDS7FD=.01):@DDS7REF@("D"),1:DDS7V)
66 .. I DDS7FD=.01,DDS7DAST_U'[(U_+DDS7DA_U) S DDS7DAST=DDS7DAST_U_+DDS7DA
67 S DDS7DAS=DDS7DAST_U
68 Q
Note: See TracBrowser for help on using the repository browser.