File:  [Coherent Logic Development] / freem_fileman / USER / DDS7.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DDS7	;SFISC/MKO-Relational ;04:34 PM  25 Jun 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: RPB(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: 	;
   19: RPF(DDP,DDSPTB,DDSDA,DA)	;Repaint and update pointer field of
   20: 	;pointer blocks because user changed the .01 value
   21: 	S DDS7V=$S($D(@DDSREFT@("F"_DDP,DDSDA,.01,"X"))#2:^("X"),1:$G(^("D")))
   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,DDS7DA,DDS7DAS,DDS7DAST,DDS7DDO,DDS7FD,DDS7FI
   27: 	K DDS7I,DDS7L,DDS7PTB,DDS7RJ,DDS7V,DDS7X
   28: 	Q
   29: RPF1	;
   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'[","  I DDS7DAS[(U_$G(^(DDS7DA,DDS7FD,"D"))_U) S:DDS7V="" ^("D")="" S:$D(^("X"))#2 ^("X")=DDS7V I DDS7FD=.01,DDS7DAST_U'[(U_+DDS7DA_U) S DDS7DAST=DDS7DAST_U_+DDS7DA
   61: 	S DDS7DAS=DDS7DAST_U
   62: 	Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>