Return to DDS7.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDS7.m, revision 1.1.1.1

1.1       snw         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